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 sub typecast_constraints {
193 my($class, $pkg, $type, $value) = @_;
194 Carp::croak("wrong arguments count") unless @_ == 4;
196 Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");
198 return $type->coerce($value);
204 # enum ['small', 'medium', 'large']
205 if (ref($_[0]) eq 'ARRAY') {
206 %valid = map{ $_ => undef } @{ $_[0] };
207 $name = sprintf '(%s)', join '|', sort @{$_[0]};
209 # enum size => 'small', 'medium', 'large'
212 %valid = map{ $_ => undef } @_;
214 return _create_type 'type', $name => (
215 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
221 sub _find_or_create_regular_type{
224 return $TYPE{$spec} if exists $TYPE{$spec};
226 my $meta = Mouse::Meta::Module::class_of($spec);
234 if($meta->isa('Mouse::Meta::Role')){
236 return blessed($_[0]) && $_[0]->does($spec);
242 return blessed($_[0]) && $_[0]->isa($spec);
247 warn "#CREATE a $type type for $spec\n" if _DEBUG;
249 return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
257 $TYPE{ArrayRef}{constraint_generator} = sub {
258 my($type_parameter) = @_;
259 my $check = $type_parameter->_compiled_type_constraint;
262 foreach my $value (@{$_}) {
263 return undef unless $check->($value);
268 $TYPE{HashRef}{constraint_generator} = sub {
269 my($type_parameter) = @_;
270 my $check = $type_parameter->_compiled_type_constraint;
273 foreach my $value(values %{$_}){
274 return undef unless $check->($value);
280 # 'Maybe' type accepts 'Any', so it requires parameters
281 $TYPE{Maybe}{constraint_generator} = sub {
282 my($type_parameter) = @_;
283 my $check = $type_parameter->_compiled_type_constraint;
286 return !defined($_) || $check->($_);
290 sub _find_or_create_parameterized_type{
291 my($base, $param) = @_;
293 my $name = sprintf '%s[%s]', $base->name, $param->name;
296 warn "#CREATE a Parameterized type for $name\n" if _DEBUG;
298 my $generator = $base->{constraint_generator};
301 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
304 Mouse::Meta::TypeConstraint->new(
307 constraint => $generator->($param),
309 type => 'Parameterized',
313 sub _find_or_create_union_type{
314 my @types = map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
316 my $name = join '|', map{ $_->name } @types;
319 warn "# CREATE a Union type for ", Mouse::Util::english_list(@types),"\n" if _DEBUG;
321 return Mouse::Meta::TypeConstraint->new(
323 type_constraints => \@types,
332 my($spec, $start) = @_;
337 my $len = length $spec;
340 for($i = $start; $i < $len; $i++){
341 my $char = substr($spec, $i, 1);
344 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
347 ($i, $subtype) = _parse_type($spec, $i+1)
349 $start = $i+1; # reset
351 push @list, _find_or_create_parameterized_type($base => $subtype);
358 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );
361 # XXX: Mouse creates a new class type, but Moose does not.
362 $type = class_type( substr($spec, $start, $i - $start) );
367 ($i, $subtype) = _parse_type($spec, $i+1)
370 $start = $i+1; # reset
372 push @list, $subtype;
376 push @list, _find_or_create_regular_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 my $type = find_or_parse_type_constriant(@_) || role_type(@_);
413 if($type->{type} && $type->{type} ne 'Role'){
414 Carp::cluck("$type is not a role type");
419 sub find_or_create_isa_type_constraint {
420 return find_or_parse_type_constraint(@_) || class_type(@_);
429 Mouse::Util::TypeConstraints - Type constraint system for Mouse
433 use Mouse::Util::TypeConstraints;
439 subtype 'NaturalLessThanTen'
442 => message { "This number ($_) is not less than ten!" };
448 enum 'RGBColors' => qw(red green blue);
450 no Mouse::Util::TypeConstraints;
454 This module provides Mouse with the ability to create custom type
455 constraints to be used in attribute definition.
457 =head2 Important Caveat
459 This is B<NOT> a type system for Perl 5. These are type constraints,
460 and they are not used by Mouse unless you tell it to. No type
461 inference is performed, expressions are not typed, etc. etc. etc.
463 A type constraint is at heart a small "check if a value is valid"
464 function. A constraint can be associated with an attribute. This
465 simplifies parameter validation, and makes your code clearer to read,
466 because you can refer to constraints by name.
468 =head2 Slightly Less Important Caveat
470 It is B<always> a good idea to quote your type names.
472 This prevents Perl from trying to execute the call as an indirect
473 object call. This can be an issue when you have a subtype with the
474 same name as a valid class.
478 subtype DateTime => as Object => where { $_->isa('DateTime') };
480 will I<just work>, while this:
483 subtype DateTime => as Object => where { $_->isa('DateTime') };
485 will fail silently and cause many headaches. The simple way to solve
486 this, as well as future proof your subtypes from classes which have
487 yet to have been created, is to quote the type name:
490 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
492 =head2 Default Type Constraints
494 This module also provides a simple hierarchy for Perl 5 types, here is
495 that hierarchy represented visually.
519 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
520 parameterized, this means you can say:
522 ArrayRef[Int] # an array of integers
523 HashRef[CodeRef] # a hash of str to CODE ref mappings
524 Maybe[Str] # value may be a string, may be undefined
526 If Mouse finds a name in brackets that it does not recognize as an
527 existing type, it assumes that this is a class name, for example
528 C<ArrayRef[DateTime]>.
530 B<NOTE:> Unless you parameterize a type, then it is invalid to include
531 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
532 name, I<not> as a parameterization of C<ArrayRef>.
534 B<NOTE:> The C<Undef> type constraint for the most part works
535 correctly now, but edge cases may still exist, please use it
538 B<NOTE:> The C<ClassName> type constraint does a complex package
539 existence check. This means that your class B<must> be loaded for this
540 type constraint to pass.
542 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
543 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
544 constraint checks that an I<object does> the named role.
546 =head2 Type Constraint Naming
548 Type name declared via this module can only contain alphanumeric
549 characters, colons (:), and periods (.).
551 Since the types created by this module are global, it is suggested
552 that you namespace your types just as you would namespace your
553 modules. So instead of creating a I<Color> type for your
554 B<My::Graphics> module, you would call the type
555 I<My::Graphics::Types::Color> instead.
557 =head2 Use with Other Constraint Modules
559 This module can play nicely with other constraint modules with some
560 slight tweaking. The C<where> clause in types is expected to be a
561 C<CODE> reference which checks it's first argument and returns a
562 boolean. Since most constraint modules work in a similar way, it
563 should be simple to adapt them to work with Mouse.
565 For instance, this is how you could use it with
566 L<Declare::Constraints::Simple> to declare a completely new type.
568 type 'HashOfArrayOfObjects',
572 -values => IsArrayRef(IsObject)
576 Here is an example of using L<Test::Deep> and it's non-test
577 related C<eq_deeply> function.
579 type 'ArrayOfHashOfBarsAndRandomNumbers'
582 array_each(subhashof({
584 random_number => ignore()
590 =head2 C<< list_all_builtin_type_constraints -> (Names) >>
592 Returns the names of builtin type constraints.
594 =head2 C<< list_all_type_constraints -> (Names) >>
596 Returns the names of all the type constraints.
602 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
604 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
606 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
608 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
610 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
616 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
622 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
626 L<Moose::Util::TypeConstraints>