1 package Mouse::Util::TypeConstraints;
8 use Scalar::Util qw/blessed looks_like_number openhandle/;
10 use Mouse::Util qw(does_role not_supported);
11 use Mouse::Meta::Module; # get_metaclass_by_name()
12 use Mouse::Meta::TypeConstraint;
14 our @ISA = qw(Exporter);
16 as where message from via type subtype coerce class_type role_type enum
28 return(where => $_[0])
31 return(message => $_[0])
39 Any => undef, # null check
40 Item => undef, # null check
41 Maybe => undef, # null check
43 Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
44 Undef => sub { !defined($_[0]) },
45 Defined => sub { defined($_[0]) },
46 Value => sub { defined($_[0]) && !ref($_[0]) },
47 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
48 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
49 Str => sub { defined($_[0]) && !ref($_[0]) },
50 Ref => sub { ref($_[0]) },
52 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
53 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
54 HashRef => sub { ref($_[0]) eq 'HASH' },
55 CodeRef => sub { ref($_[0]) eq 'CODE' },
56 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
57 GlobRef => sub { ref($_[0]) eq 'GLOB' },
60 ref($_[0]) eq 'GLOB' && openhandle($_[0])
62 blessed($_[0]) && $_[0]->isa("IO::Handle")
65 Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
67 ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
68 RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
71 while (my ($name, $code) = each %builtins) {
72 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
78 sub optimized_constraints {
79 Carp::cluck('optimized_constraints() has been deprecated');
83 my @builtins = keys %TYPE;
84 sub list_all_builtin_type_constraints { @builtins }
86 sub list_all_type_constraints { keys %TYPE }
95 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
98 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
102 elsif(@_ % 2){ # @_ : $name => ( where => ... )
105 else{ # @_ : (name => $name, where => ...)
110 if(!defined($name = $args{name})){
117 my $package_defined_in = $args{package_defined_in} ||= caller(1);
119 my $existing = $TYPE{$name};
120 if($existing && $existing->{package_defined_in} ne $package_defined_in){
121 confess("The type constraint '$name' has already been created in "
122 . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
125 $args{constraint} = delete($args{where}) if exists $args{where};
126 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
129 if($mode eq 'subtype'){
130 my $parent = delete($args{as})
131 or confess('A subtype cannot consist solely of a name, it must have a parent');
133 $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
136 $constraint = Mouse::Meta::TypeConstraint->new(%args);
139 return $TYPE{$name} = $constraint;
143 return _create_type('type', @_);
147 return _create_type('subtype', @_);
151 my $type_name = shift;
153 my $type = find_type_constraint($type_name)
154 or confess("Cannot find type '$type_name', perhaps you forgot to load it.");
156 $type->_add_type_coercions(@_);
161 my($name, $conf) = @_;
162 if ($conf && $conf->{class}) {
163 # No, you're using this wrong
164 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
165 _create_type 'type', $name => (
166 as => $conf->{class},
172 _create_type 'type', $name => (
173 optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },
181 my($name, $conf) = @_;
182 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
183 _create_type 'type', $name => (
184 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
190 sub typecast_constraints {
191 my($class, $pkg, $type, $value) = @_;
192 Carp::croak("wrong arguments count") unless @_ == 4;
194 Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");
196 return $type->coerce($value);
202 # enum ['small', 'medium', 'large']
203 if (ref($_[0]) eq 'ARRAY') {
204 %valid = map{ $_ => undef } @{ $_[0] };
205 $name = sprintf '(%s)', join '|', sort @{$_[0]};
207 # enum size => 'small', 'medium', 'large'
210 %valid = map{ $_ => undef } @_;
212 return _create_type 'type', $name => (
213 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
219 sub _find_or_create_regular_type{
222 return $TYPE{$spec} if exists $TYPE{$spec};
224 my $meta = Mouse::Meta::Module::get_metaclass_by_name($spec);
232 if($meta->isa('Mouse::Meta::Role')){
234 return blessed($_[0]) && $_[0]->does($spec);
240 return blessed($_[0]) && $_[0]->isa($spec);
245 return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
253 $TYPE{ArrayRef}{constraint_generator} = sub {
254 my($type_parameter) = @_;
255 my $check = $type_parameter->_compiled_type_constraint;
258 foreach my $value (@{$_}) {
259 return undef unless $check->($value);
264 $TYPE{HashRef}{constraint_generator} = sub {
265 my($type_parameter) = @_;
266 my $check = $type_parameter->_compiled_type_constraint;
269 foreach my $value(values %{$_}){
270 return undef unless $check->($value);
276 # 'Maybe' type accepts 'Any', so it requires parameters
277 $TYPE{Maybe}{constraint_generator} = sub {
278 my($type_parameter) = @_;
279 my $check = $type_parameter->_compiled_type_constraint;
282 return !defined($_) || $check->($_);
286 sub _find_or_create_parameterized_type{
287 my($base, $param) = @_;
289 my $name = sprintf '%s[%s]', $base->name, $param->name;
292 my $generator = $base->{constraint_generator};
295 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
298 Mouse::Meta::TypeConstraint->new(
301 constraint => $generator->($param),
303 type => 'Parameterized',
307 sub _find_or_create_union_type{
308 my @types = map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
310 my $name = join '|', map{ $_->name } @types;
313 return Mouse::Meta::TypeConstraint->new(
315 type_constraints => \@types,
324 my($spec, $start) = @_;
329 my $len = length $spec;
332 for($i = $start; $i < $len; $i++){
333 my $char = substr($spec, $i, 1);
336 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
339 ($i, $subtype) = _parse_type($spec, $i+1)
341 $start = $i+1; # reset
343 push @list, _find_or_create_parameterized_type($base => $subtype);
350 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
353 # XXX: Mouse creates a new class type, but Moose does not.
354 $type = class_type( substr($spec, $start, $i - $start) );
359 ($i, $subtype) = _parse_type($spec, $i+1)
362 $start = $i+1; # reset
364 push @list, $subtype;
368 push @list, _find_or_create_regular_type(substr $spec, $start, $i - $start);
375 return ($len, $list[0]);
378 return ($len, _find_or_create_union_type(@list));
383 sub find_type_constraint {
385 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
391 sub find_or_parse_type_constraint {
393 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
396 return $TYPE{$spec} || do{
397 my($pos, $type) = _parse_type($spec, 0);
402 sub find_or_create_does_type_constraint{
403 my $type = find_or_parse_type_constriant(@_) || role_type(@_);
405 if($type->{type} && $type->{type} ne 'Role'){
406 Carp::cluck("$type is not a role type");
411 sub find_or_create_isa_type_constraint {
412 return find_or_parse_type_constraint(@_) || class_type(@_);
421 Mouse::Util::TypeConstraints - Type constraint system for Mouse
425 use Mouse::Util::TypeConstraints;
431 subtype 'NaturalLessThanTen'
434 => message { "This number ($_) is not less than ten!" };
440 enum 'RGBColors' => qw(red green blue);
442 no Mouse::Util::TypeConstraints;
446 This module provides Mouse with the ability to create custom type
447 constraints to be used in attribute definition.
449 =head2 Important Caveat
451 This is B<NOT> a type system for Perl 5. These are type constraints,
452 and they are not used by Mouse unless you tell it to. No type
453 inference is performed, expressions are not typed, etc. etc. etc.
455 A type constraint is at heart a small "check if a value is valid"
456 function. A constraint can be associated with an attribute. This
457 simplifies parameter validation, and makes your code clearer to read,
458 because you can refer to constraints by name.
460 =head2 Slightly Less Important Caveat
462 It is B<always> a good idea to quote your type names.
464 This prevents Perl from trying to execute the call as an indirect
465 object call. This can be an issue when you have a subtype with the
466 same name as a valid class.
470 subtype DateTime => as Object => where { $_->isa('DateTime') };
472 will I<just work>, while this:
475 subtype DateTime => as Object => where { $_->isa('DateTime') };
477 will fail silently and cause many headaches. The simple way to solve
478 this, as well as future proof your subtypes from classes which have
479 yet to have been created, is to quote the type name:
482 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
484 =head2 Default Type Constraints
486 This module also provides a simple hierarchy for Perl 5 types, here is
487 that hierarchy represented visually.
511 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
512 parameterized, this means you can say:
514 ArrayRef[Int] # an array of integers
515 HashRef[CodeRef] # a hash of str to CODE ref mappings
516 Maybe[Str] # value may be a string, may be undefined
518 If Mouse finds a name in brackets that it does not recognize as an
519 existing type, it assumes that this is a class name, for example
520 C<ArrayRef[DateTime]>.
522 B<NOTE:> Unless you parameterize a type, then it is invalid to include
523 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
524 name, I<not> as a parameterization of C<ArrayRef>.
526 B<NOTE:> The C<Undef> type constraint for the most part works
527 correctly now, but edge cases may still exist, please use it
530 B<NOTE:> The C<ClassName> type constraint does a complex package
531 existence check. This means that your class B<must> be loaded for this
532 type constraint to pass.
534 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
535 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
536 constraint checks that an I<object does> the named role.
538 =head2 Type Constraint Naming
540 Type name declared via this module can only contain alphanumeric
541 characters, colons (:), and periods (.).
543 Since the types created by this module are global, it is suggested
544 that you namespace your types just as you would namespace your
545 modules. So instead of creating a I<Color> type for your
546 B<My::Graphics> module, you would call the type
547 I<My::Graphics::Types::Color> instead.
549 =head2 Use with Other Constraint Modules
551 This module can play nicely with other constraint modules with some
552 slight tweaking. The C<where> clause in types is expected to be a
553 C<CODE> reference which checks it's first argument and returns a
554 boolean. Since most constraint modules work in a similar way, it
555 should be simple to adapt them to work with Mouse.
557 For instance, this is how you could use it with
558 L<Declare::Constraints::Simple> to declare a completely new type.
560 type 'HashOfArrayOfObjects',
564 -values => IsArrayRef(IsObject)
568 Here is an example of using L<Test::Deep> and it's non-test
569 related C<eq_deeply> function.
571 type 'ArrayOfHashOfBarsAndRandomNumbers'
574 array_each(subhashof({
576 random_number => ignore()
582 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
584 Returns the names of builtin type constraints.
586 =head2 C<< list_all_type_constraints -> (Names) >>
588 Returns the names of all the type constraints.
594 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
596 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
598 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
600 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
602 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
608 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
614 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
618 L<Moose::Util::TypeConstraints>