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 my $type = _find_or_create_regular_type( substr $spec, $start, $i - $start );
374 # create a new class type
375 push @list, class_type( substr $spec, $start, $i - $start );
383 return ($len, $list[0]);
386 return ($len, _find_or_create_union_type(@list));
391 sub find_type_constraint {
393 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
399 sub find_or_parse_type_constraint {
401 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
404 return $TYPE{$spec} || do{
405 my($pos, $type) = _parse_type($spec, 0);
410 sub find_or_create_does_type_constraint{
411 return find_or_parse_type_constraint(@_) || role_type(@_);
414 sub find_or_create_isa_type_constraint {
415 return find_or_parse_type_constraint(@_) || class_type(@_);
424 Mouse::Util::TypeConstraints - Type constraint system for Mouse
428 This document describes Mouse version 0.39
432 use Mouse::Util::TypeConstraints;
438 subtype 'NaturalLessThanTen'
441 => message { "This number ($_) is not less than ten!" };
447 enum 'RGBColors' => qw(red green blue);
449 no Mouse::Util::TypeConstraints;
453 This module provides Mouse with the ability to create custom type
454 constraints to be used in attribute definition.
456 =head2 Important Caveat
458 This is B<NOT> a type system for Perl 5. These are type constraints,
459 and they are not used by Mouse unless you tell it to. No type
460 inference is performed, expressions are not typed, etc. etc. etc.
462 A type constraint is at heart a small "check if a value is valid"
463 function. A constraint can be associated with an attribute. This
464 simplifies parameter validation, and makes your code clearer to read,
465 because you can refer to constraints by name.
467 =head2 Slightly Less Important Caveat
469 It is B<always> a good idea to quote your type names.
471 This prevents Perl from trying to execute the call as an indirect
472 object call. This can be an issue when you have a subtype with the
473 same name as a valid class.
477 subtype DateTime => as Object => where { $_->isa('DateTime') };
479 will I<just work>, while this:
482 subtype DateTime => as Object => where { $_->isa('DateTime') };
484 will fail silently and cause many headaches. The simple way to solve
485 this, as well as future proof your subtypes from classes which have
486 yet to have been created, is to quote the type name:
489 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
491 =head2 Default Type Constraints
493 This module also provides a simple hierarchy for Perl 5 types, here is
494 that hierarchy represented visually.
518 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
519 parameterized, this means you can say:
521 ArrayRef[Int] # an array of integers
522 HashRef[CodeRef] # a hash of str to CODE ref mappings
523 Maybe[Str] # value may be a string, may be undefined
525 If Mouse finds a name in brackets that it does not recognize as an
526 existing type, it assumes that this is a class name, for example
527 C<ArrayRef[DateTime]>.
529 B<NOTE:> Unless you parameterize a type, then it is invalid to include
530 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
531 name, I<not> as a parameterization of C<ArrayRef>.
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<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
603 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
605 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
607 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
609 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
615 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
621 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
625 L<Moose::Util::TypeConstraints>