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; # class_of
12 use Mouse::Meta::TypeConstraint;
14 use constant _DEBUG => !!$ENV{TC_DEBUG};
16 our @ISA = qw(Exporter);
18 as where message from via type subtype coerce class_type role_type enum
30 return(where => $_[0])
33 return(message => $_[0])
41 Any => undef, # null check
42 Item => undef, # null check
43 Maybe => undef, # null check
45 Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
46 Undef => sub { !defined($_[0]) },
47 Defined => sub { defined($_[0]) },
48 Value => sub { defined($_[0]) && !ref($_[0]) },
49 Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
50 Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
51 Str => sub { defined($_[0]) && !ref($_[0]) },
52 Ref => sub { ref($_[0]) },
54 ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
55 ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
56 HashRef => sub { ref($_[0]) eq 'HASH' },
57 CodeRef => sub { ref($_[0]) eq 'CODE' },
58 RegexpRef => sub { ref($_[0]) eq 'Regexp' },
59 GlobRef => sub { ref($_[0]) eq 'GLOB' },
62 ref($_[0]) eq 'GLOB' && openhandle($_[0])
64 blessed($_[0]) && $_[0]->isa("IO::Handle")
67 Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
69 ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
70 RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
73 while (my ($name, $code) = each %builtins) {
74 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
80 sub optimized_constraints {
81 Carp::cluck('optimized_constraints() has been deprecated');
85 my @builtins = keys %TYPE;
86 sub list_all_builtin_type_constraints { @builtins }
88 sub list_all_type_constraints { keys %TYPE }
97 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
100 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
104 elsif(@_ % 2){ # @_ : $name => ( where => ... )
107 else{ # @_ : (name => $name, where => ...)
112 if(!defined($name = $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 my $parent = delete($args{as})
133 or confess('A subtype cannot consist solely of a name, it must have a parent');
135 $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
138 $constraint = Mouse::Meta::TypeConstraint->new(%args);
141 return $TYPE{$name} = $constraint;
145 return _create_type('type', @_);
149 return _create_type('subtype', @_);
153 my $type_name = shift;
155 my $type = find_type_constraint($type_name)
156 or confess("Cannot find type '$type_name', perhaps you forgot to load it.");
158 $type->_add_type_coercions(@_);
163 my($name, $conf) = @_;
164 if ($conf && $conf->{class}) {
165 # No, you're using this wrong
166 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
167 _create_type 'type', $name => (
168 as => $conf->{class},
174 _create_type 'type', $name => (
175 optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },
183 my($name, $conf) = @_;
184 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
185 _create_type 'type', $name => (
186 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
192 # this is an original method for Mouse
193 sub typecast_constraints {
194 my($class, $pkg, $type, $value) = @_;
195 Carp::croak("wrong arguments count") unless @_ == 4;
197 return $type->coerce($value);
203 # enum ['small', 'medium', 'large']
204 if (ref($_[0]) eq 'ARRAY') {
205 %valid = map{ $_ => undef } @{ $_[0] };
206 $name = sprintf '(%s)', join '|', sort @{$_[0]};
208 # enum size => 'small', 'medium', 'large'
211 %valid = map{ $_ => undef } @_;
213 return _create_type 'type', $name => (
214 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
220 sub _find_or_create_regular_type{
223 return $TYPE{$spec} if exists $TYPE{$spec};
225 my $meta = Mouse::Meta::Module::class_of($spec);
233 if($meta->isa('Mouse::Meta::Role')){
235 return blessed($_[0]) && $_[0]->does($spec);
241 return blessed($_[0]) && $_[0]->isa($spec);
246 warn "#CREATE a $type type for $spec\n" if _DEBUG;
248 return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
256 $TYPE{ArrayRef}{constraint_generator} = sub {
257 my($type_parameter) = @_;
258 my $check = $type_parameter->_compiled_type_constraint;
261 foreach my $value (@{$_}) {
262 return undef unless $check->($value);
267 $TYPE{HashRef}{constraint_generator} = sub {
268 my($type_parameter) = @_;
269 my $check = $type_parameter->_compiled_type_constraint;
272 foreach my $value(values %{$_}){
273 return undef unless $check->($value);
279 # 'Maybe' type accepts 'Any', so it requires parameters
280 $TYPE{Maybe}{constraint_generator} = sub {
281 my($type_parameter) = @_;
282 my $check = $type_parameter->_compiled_type_constraint;
285 return !defined($_) || $check->($_);
289 sub _find_or_create_parameterized_type{
290 my($base, $param) = @_;
292 my $name = sprintf '%s[%s]', $base->name, $param->name;
295 warn "#CREATE a Parameterized type for $name\n" if _DEBUG;
297 my $generator = $base->{constraint_generator};
300 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
303 Mouse::Meta::TypeConstraint->new(
306 constraint => $generator->($param),
308 type => 'Parameterized',
312 sub _find_or_create_union_type{
313 my @types = map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
315 my $name = join '|', map{ $_->name } @types;
318 warn "# CREATE a Union type for ", Mouse::Util::english_list(@types),"\n" if _DEBUG;
320 return Mouse::Meta::TypeConstraint->new(
322 type_constraints => \@types,
331 my($spec, $start) = @_;
336 my $len = length $spec;
339 for($i = $start; $i < $len; $i++){
340 my $char = substr($spec, $i, 1);
343 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
346 ($i, $subtype) = _parse_type($spec, $i+1)
348 $start = $i+1; # reset
350 push @list, _find_or_create_parameterized_type($base => $subtype);
357 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
360 # XXX: Mouse creates a new class type, but Moose does not.
361 $type = class_type( substr($spec, $start, $i - $start) );
366 ($i, $subtype) = _parse_type($spec, $i+1)
369 $start = $i+1; # reset
371 push @list, $subtype;
375 push @list, _find_or_create_regular_type(substr $spec, $start, $i - $start);
382 return ($len, $list[0]);
385 return ($len, _find_or_create_union_type(@list));
390 sub find_type_constraint {
392 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
398 sub find_or_parse_type_constraint {
400 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
403 return $TYPE{$spec} || do{
404 my($pos, $type) = _parse_type($spec, 0);
409 sub find_or_create_does_type_constraint{
410 my $type = find_or_parse_type_constriant(@_) || role_type(@_);
412 if($type->{type} && $type->{type} ne 'Role'){
413 Carp::cluck("$type is not a role type");
418 sub find_or_create_isa_type_constraint {
419 return find_or_parse_type_constraint(@_) || class_type(@_);
428 Mouse::Util::TypeConstraints - Type constraint system for Mouse
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>