1 package Mouse::Util::TypeConstraints;
2 use Mouse::Util qw(does_role not_supported); # enables strict and warnings
5 use Scalar::Util qw/blessed looks_like_number openhandle/;
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
23 sub as ($) { (as => $_[0]) }
24 sub where (&) { (where => $_[0]) }
25 sub message (&) { (message => $_[0]) }
26 sub optimize_as (&) { (optimize_as => $_[0]) }
33 Any => undef, # null check
34 Item => undef, # null check
35 Maybe => undef, # null check
37 Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
38 Undef => sub { !defined($_[0]) },
39 Defined => sub { defined($_[0]) },
40 Value => sub { defined($_[0]) && !ref($_[0]) },
41 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
42 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
43 Str => sub { defined($_[0]) && !ref($_[0]) },
44 Ref => sub { ref($_[0]) },
46 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
47 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
48 HashRef => sub { ref($_[0]) eq 'HASH' },
49 CodeRef => sub { ref($_[0]) eq 'CODE' },
50 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
51 GlobRef => sub { ref($_[0]) eq 'GLOB' },
54 ref($_[0]) eq 'GLOB' && openhandle($_[0])
56 blessed($_[0]) && $_[0]->isa("IO::Handle")
59 Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
61 ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
62 RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
65 while (my ($name, $code) = each %builtins) {
66 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
72 sub optimized_constraints { # DEPRECATED
73 Carp::cluck('optimized_constraints() has been deprecated');
77 my @builtins = keys %TYPE;
78 sub list_all_builtin_type_constraints { @builtins }
80 sub list_all_type_constraints { keys %TYPE }
89 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
92 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
96 elsif(@_ % 2){ # @_ : $name => ( where => ... )
99 else{ # @_ : (name => $name, where => ...)
104 if(!defined($name = $args{name})){
111 if($mode eq 'subtype'){
112 $parent = delete $args{as};
114 $parent = delete $args{name};
119 my $package_defined_in = $args{package_defined_in} ||= caller(1);
121 my $existing = $TYPE{$name};
122 if($existing && $existing->{package_defined_in} ne $package_defined_in){
123 confess("The type constraint '$name' has already been created in "
124 . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
127 $args{constraint} = delete $args{where} if exists $args{where};
128 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
131 if($mode eq 'subtype'){
132 $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
135 $constraint = Mouse::Meta::TypeConstraint->new(%args);
138 return $TYPE{$name} = $constraint;
142 return _create_type('type', @_);
146 return _create_type('subtype', @_);
150 my $type_name = shift;
152 my $type = find_type_constraint($type_name)
153 or confess("Cannot find type '$type_name', perhaps you forgot to load it.");
155 $type->_add_type_coercions(@_);
160 my($name, $conf) = @_;
161 if ($conf && $conf->{class}) {
162 # No, you're using this wrong
163 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
164 _create_type 'type', $name => (
165 as => $conf->{class},
171 _create_type 'type', $name => (
172 optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },
180 my($name, $conf) = @_;
181 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
182 _create_type 'type', $name => (
183 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
189 sub typecast_constraints { # DEPRECATED
190 my($class, $pkg, $type, $value) = @_;
191 Carp::croak("wrong arguments count") unless @_ == 4;
193 Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");
195 return $type->coerce($value);
201 # enum ['small', 'medium', 'large']
202 if (ref($_[0]) eq 'ARRAY') {
203 %valid = map{ $_ => undef } @{ $_[0] };
204 $name = sprintf '(%s)', join '|', sort @{$_[0]};
206 # enum size => 'small', 'medium', 'large'
209 %valid = map{ $_ => undef } @_;
211 return _create_type 'type', $name => (
212 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
218 sub _find_or_create_regular_type{
221 return $TYPE{$spec} if exists $TYPE{$spec};
223 my $meta = Mouse::Util::get_metaclass_by_name($spec);
231 if($meta->isa('Mouse::Meta::Role')){
233 return blessed($_[0]) && $_[0]->does($spec);
239 return blessed($_[0]) && $_[0]->isa($spec);
244 return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
252 $TYPE{ArrayRef}{constraint_generator} = sub {
253 my($type_parameter) = @_;
254 my $check = $type_parameter->_compiled_type_constraint;
257 foreach my $value (@{$_}) {
258 return undef unless $check->($value);
263 $TYPE{HashRef}{constraint_generator} = sub {
264 my($type_parameter) = @_;
265 my $check = $type_parameter->_compiled_type_constraint;
268 foreach my $value(values %{$_}){
269 return undef unless $check->($value);
275 # 'Maybe' type accepts 'Any', so it requires parameters
276 $TYPE{Maybe}{constraint_generator} = sub {
277 my($type_parameter) = @_;
278 my $check = $type_parameter->_compiled_type_constraint;
281 return !defined($_) || $check->($_);
285 sub _find_or_create_parameterized_type{
286 my($base, $param) = @_;
288 my $name = sprintf '%s[%s]', $base->name, $param->name;
291 my $generator = $base->{constraint_generator};
294 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
297 Mouse::Meta::TypeConstraint->new(
300 constraint => $generator->($param),
302 type => 'Parameterized',
306 sub _find_or_create_union_type{
307 my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
309 my $name = join '|', @types;
312 return Mouse::Meta::TypeConstraint->new(
314 type_constraints => \@types,
323 my($spec, $start) = @_;
328 my $len = length $spec;
331 for($i = $start; $i < $len; $i++){
332 my $char = substr($spec, $i, 1);
335 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
338 ($i, $subtype) = _parse_type($spec, $i+1)
340 $start = $i+1; # reset
342 push @list, _find_or_create_parameterized_type($base => $subtype);
349 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
352 # XXX: Mouse creates a new class type, but Moose does not.
353 $type = class_type( substr($spec, $start, $i - $start) );
358 ($i, $subtype) = _parse_type($spec, $i+1)
361 $start = $i+1; # reset
363 push @list, $subtype;
367 push @list, _find_or_create_regular_type(substr $spec, $start, $i - $start);
374 return ($len, $list[0]);
377 return ($len, _find_or_create_union_type(@list));
382 sub find_type_constraint {
384 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
390 sub find_or_parse_type_constraint {
392 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
395 return $TYPE{$spec} || do{
396 my($pos, $type) = _parse_type($spec, 0);
401 sub find_or_create_does_type_constraint{
402 my $type = find_or_parse_type_constraint(@_) || role_type(@_);
404 if($type->{type} && $type->{type} ne 'Role'){
405 Carp::cluck("$type is not a role type");
410 sub find_or_create_isa_type_constraint {
411 return find_or_parse_type_constraint(@_) || class_type(@_);
420 Mouse::Util::TypeConstraints - Type constraint system for Mouse
424 use Mouse::Util::TypeConstraints;
430 subtype 'NaturalLessThanTen'
433 => message { "This number ($_) is not less than ten!" };
439 enum 'RGBColors' => qw(red green blue);
441 no Mouse::Util::TypeConstraints;
445 This module provides Mouse with the ability to create custom type
446 constraints to be used in attribute definition.
448 =head2 Important Caveat
450 This is B<NOT> a type system for Perl 5. These are type constraints,
451 and they are not used by Mouse unless you tell it to. No type
452 inference is performed, expressions are not typed, etc. etc. etc.
454 A type constraint is at heart a small "check if a value is valid"
455 function. A constraint can be associated with an attribute. This
456 simplifies parameter validation, and makes your code clearer to read,
457 because you can refer to constraints by name.
459 =head2 Slightly Less Important Caveat
461 It is B<always> a good idea to quote your type names.
463 This prevents Perl from trying to execute the call as an indirect
464 object call. This can be an issue when you have a subtype with the
465 same name as a valid class.
469 subtype DateTime => as Object => where { $_->isa('DateTime') };
471 will I<just work>, while this:
474 subtype DateTime => as Object => where { $_->isa('DateTime') };
476 will fail silently and cause many headaches. The simple way to solve
477 this, as well as future proof your subtypes from classes which have
478 yet to have been created, is to quote the type name:
481 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
483 =head2 Default Type Constraints
485 This module also provides a simple hierarchy for Perl 5 types, here is
486 that hierarchy represented visually.
510 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
511 parameterized, this means you can say:
513 ArrayRef[Int] # an array of integers
514 HashRef[CodeRef] # a hash of str to CODE ref mappings
515 Maybe[Str] # value may be a string, may be undefined
517 If Mouse finds a name in brackets that it does not recognize as an
518 existing type, it assumes that this is a class name, for example
519 C<ArrayRef[DateTime]>.
521 B<NOTE:> Unless you parameterize a type, then it is invalid to include
522 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
523 name, I<not> as a parameterization of C<ArrayRef>.
525 B<NOTE:> The C<Undef> type constraint for the most part works
526 correctly now, but edge cases may still exist, please use it
529 B<NOTE:> The C<ClassName> type constraint does a complex package
530 existence check. This means that your class B<must> be loaded for this
531 type constraint to pass.
533 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
534 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
535 constraint checks that an I<object does> the named role.
537 =head2 Type Constraint Naming
539 Type name declared via this module can only contain alphanumeric
540 characters, colons (:), and periods (.).
542 Since the types created by this module are global, it is suggested
543 that you namespace your types just as you would namespace your
544 modules. So instead of creating a I<Color> type for your
545 B<My::Graphics> module, you would call the type
546 I<My::Graphics::Types::Color> instead.
548 =head2 Use with Other Constraint Modules
550 This module can play nicely with other constraint modules with some
551 slight tweaking. The C<where> clause in types is expected to be a
552 C<CODE> reference which checks it's first argument and returns a
553 boolean. Since most constraint modules work in a similar way, it
554 should be simple to adapt them to work with Mouse.
556 For instance, this is how you could use it with
557 L<Declare::Constraints::Simple> to declare a completely new type.
559 type 'HashOfArrayOfObjects',
563 -values => IsArrayRef(IsObject)
567 Here is an example of using L<Test::Deep> and it's non-test
568 related C<eq_deeply> function.
570 type 'ArrayOfHashOfBarsAndRandomNumbers'
573 array_each(subhashof({
575 random_number => ignore()
581 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
583 Returns the names of builtin type constraints.
585 =head2 C<< list_all_type_constraints -> (Names) >>
587 Returns the names of all the type constraints.
593 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
595 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
597 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
599 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
601 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
607 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
613 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
617 L<Moose::Util::TypeConstraints>