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(
76 _compiled_type_constraint => $code,
77 package_defined_in => __PACKAGE__,
81 sub optimized_constraints {
82 Carp::cluck('optimized_constraints() has been deprecated');
86 my @builtins = keys %TYPE;
87 sub list_all_builtin_type_constraints { @builtins }
89 sub list_all_type_constraints { keys %TYPE }
98 if(@_ == 1 && ref $_[0]){ # @_ : { name => $name, where => ... }
101 elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
105 elsif(@_ % 2){ # @_ : $name => ( where => ... )
108 else{ # @_ : (name => $name, where => ...)
113 if(!defined($name = $args{name})){
120 my $package_defined_in = $args{package_defined_in} ||= caller(1);
122 my $existing = $TYPE{$name};
123 if($existing && $existing->{package_defined_in} ne $package_defined_in){
124 confess("The type constraint '$name' has already been created in "
125 . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
128 $args{constraint} = delete($args{where})
129 if exists $args{where};
130 $args{_compiled_type_constraint} = delete $args{optimized_as}
131 if exists $args{optimized_as};
134 if($mode eq 'subtype'){
135 my $parent = exists($args{as}) ? delete($args{as}) : delete($args{name});
137 $parent = find_or_create_isa_type_constraint($parent);
138 $constraint = $parent->create_child_type(%args);
141 $constraint = Mouse::Meta::TypeConstraint->new(%args);
144 return $TYPE{$name} = $constraint;
148 return _create_type('type', @_);
152 return _create_type('subtype', @_);
159 confess "Cannot find type '$name', perhaps you forgot to load it."
162 unless ($COERCE{$name}) {
164 $COERCE_KEYS{$name} = [];
167 my $package_defined_in = caller;
169 while (my($from, $action) = splice @_, 0, 2) {
172 confess "A coercion action already exists for '$from'"
173 if $COERCE{$name}->{$from};
175 my $type = find_or_parse_type_constraint($from, $package_defined_in);
177 confess "Could not find the type constraint ($from) to coerce from"
180 warn "# REGISTER COERCE $name, from $type\n" if _DEBUG;
182 push @{ $COERCE_KEYS{$name} }, $type;
183 $COERCE{$name}->{$from} = $action;
189 my($name, $conf) = @_;
190 if ($conf && $conf->{class}) {
191 # No, you're using this wrong
192 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
193 _create_type 'type', $name => (
194 as => $conf->{class},
200 _create_type 'type', $name => (
201 optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },
209 my($name, $conf) = @_;
210 my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
211 _create_type 'type', $name => (
212 optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
218 # this is an original method for Mouse
219 sub typecast_constraints {
220 my($class, $pkg, $types, $value) = @_;
221 Carp::croak("wrong arguments count") unless @_ == 4;
224 for my $type ($types->{type_constraints} ? @{$types->{type_constraints}} : $types ) {
225 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
228 warn sprintf "# COERCE: from %s to %s for %s (%s)\n",
229 $coerce_type, $type, defined($value) ? "'$value'" : 'undef',
230 $coerce_type->check($value) ? "try" : "skip";
233 next if !$coerce_type->check($value);
237 my $coerced = $COERCE{$type}->{$coerce_type}->($value); # coerce
240 warn sprintf "# COERCE: got %s, which is%s %s\n",
241 defined($coerced) ? $coerced : 'undef', $types->check($coerced) ? '' : ' not', $types;
244 # check with $types, not $constraint
245 return $coerced if $types->check($coerced);
248 return $value; # returns original $value
254 # enum ['small', 'medium', 'large']
255 if (ref($_[0]) eq 'ARRAY') {
256 %valid = map{ $_ => undef } @{ $_[0] };
257 $name = sprintf '(%s)', join '|', sort @{$_[0]};
259 # enum size => 'small', 'medium', 'large'
262 %valid = map{ $_ => undef } @_;
264 return _create_type 'type', $name => (
265 optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },
271 sub _find_or_create_regular_type{
274 return $TYPE{$spec} if exists $TYPE{$spec};
276 my $meta = Mouse::Meta::Module::class_of($spec);
284 if($meta && $meta->isa('Mouse::Meta::Role')){
286 return blessed($_[0]) && $_[0]->does($spec);
292 return blessed($_[0]) && $_[0]->isa($spec);
297 warn "#CREATE a $type type for $spec\n" if _DEBUG;
299 return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
301 _compiled_type_constraint => $check,
307 $TYPE{ArrayRef}{constraint_generator} = sub {
308 my($type_parameter) = @_;
309 my $check = $type_parameter->{_compiled_type_constraint};
312 foreach my $value (@{$_}) {
313 return undef unless $check->($value);
318 $TYPE{HashRef}{constraint_generator} = sub {
319 my($type_parameter) = @_;
320 my $check = $type_parameter->{_compiled_type_constraint};
323 foreach my $value(values %{$_}){
324 return undef unless $check->($value);
330 # 'Maybe' type accepts 'Any', so it requires parameters
331 $TYPE{Maybe}{constraint_generator} = sub {
332 my($type_parameter) = @_;
333 my $check = $type_parameter->{_compiled_type_constraint};
336 return !defined($_) || $check->($_);
340 sub _find_or_create_parameterized_type{
341 my($base, $param) = @_;
343 my $name = sprintf '%s[%s]', $base->name, $param->name;
346 warn "#CREATE a Parameterized type for $name\n" if _DEBUG;
348 my $generator = $base->{constraint_generator};
351 confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
354 Mouse::Meta::TypeConstraint->new(
357 constraint => $generator->($param),
359 type => 'Parameterized',
363 sub _find_or_create_union_type{
364 my @types = map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
366 my $name = join '|', map{ $_->name } @types;
369 warn "# CREATE a Union type for ", Mouse::Util::english_list(@types),"\n" if _DEBUG;
371 my @checks = map{ $_->{_compiled_type_constraint} } @types;
373 foreach my $c(@checks){
374 return 1 if $c->($_[0]);
379 return Mouse::Meta::TypeConstraint->new(
381 _compiled_type_constraint => $check,
382 type_constraints => \@types,
391 my($spec, $start) = @_;
396 my $len = length $spec;
399 for($i = $start; $i < $len; $i++){
400 my $char = substr($spec, $i, 1);
403 my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start))
406 ($i, $subtype) = _parse_type($spec, $i+1)
408 $start = $i+1; # reset
410 push @list, _find_or_create_parameterized_type($base => $subtype);
417 my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start))
422 ($i, $subtype) = _parse_type($spec, $i+1)
425 $start = $i+1; # reset
427 push @list, $subtype;
431 push @list, _find_or_create_regular_type(substr $spec, $start, $i - $start);
438 return ($len, $list[0]);
441 return ($len, _find_or_create_union_type(@list));
446 sub find_type_constraint {
448 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
454 sub find_or_parse_type_constraint {
456 return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
459 return $TYPE{$spec} || do{
460 my($pos, $type) = _parse_type($spec, 0);
465 sub find_or_create_does_type_constraint{
466 my $type = find_or_parse_type_constriant(@_) || role_type(@_);
468 if($type->{type} && $type->{type} ne 'Role'){
469 Carp::cluck("$type is not a role type");
474 sub find_or_create_isa_type_constraint {
475 return find_or_parse_type_constraint(@_) || class_type(@_);
484 Mouse::Util::TypeConstraints - Type constraint system for Mouse
488 use Mouse::Util::TypeConstraints;
494 subtype 'NaturalLessThanTen'
497 => message { "This number ($_) is not less than ten!" };
503 enum 'RGBColors' => qw(red green blue);
505 no Mouse::Util::TypeConstraints;
509 This module provides Mouse with the ability to create custom type
510 constraints to be used in attribute definition.
512 =head2 Important Caveat
514 This is B<NOT> a type system for Perl 5. These are type constraints,
515 and they are not used by Mouse unless you tell it to. No type
516 inference is performed, expressions are not typed, etc. etc. etc.
518 A type constraint is at heart a small "check if a value is valid"
519 function. A constraint can be associated with an attribute. This
520 simplifies parameter validation, and makes your code clearer to read,
521 because you can refer to constraints by name.
523 =head2 Slightly Less Important Caveat
525 It is B<always> a good idea to quote your type names.
527 This prevents Perl from trying to execute the call as an indirect
528 object call. This can be an issue when you have a subtype with the
529 same name as a valid class.
533 subtype DateTime => as Object => where { $_->isa('DateTime') };
535 will I<just work>, while this:
538 subtype DateTime => as Object => where { $_->isa('DateTime') };
540 will fail silently and cause many headaches. The simple way to solve
541 this, as well as future proof your subtypes from classes which have
542 yet to have been created, is to quote the type name:
545 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
547 =head2 Default Type Constraints
549 This module also provides a simple hierarchy for Perl 5 types, here is
550 that hierarchy represented visually.
574 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
575 parameterized, this means you can say:
577 ArrayRef[Int] # an array of integers
578 HashRef[CodeRef] # a hash of str to CODE ref mappings
579 Maybe[Str] # value may be a string, may be undefined
581 If Mouse finds a name in brackets that it does not recognize as an
582 existing type, it assumes that this is a class name, for example
583 C<ArrayRef[DateTime]>.
585 B<NOTE:> Unless you parameterize a type, then it is invalid to include
586 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
587 name, I<not> as a parameterization of C<ArrayRef>.
589 B<NOTE:> The C<Undef> type constraint for the most part works
590 correctly now, but edge cases may still exist, please use it
593 B<NOTE:> The C<ClassName> type constraint does a complex package
594 existence check. This means that your class B<must> be loaded for this
595 type constraint to pass.
597 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
598 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
599 constraint checks that an I<object does> the named role.
601 =head2 Type Constraint Naming
603 Type name declared via this module can only contain alphanumeric
604 characters, colons (:), and periods (.).
606 Since the types created by this module are global, it is suggested
607 that you namespace your types just as you would namespace your
608 modules. So instead of creating a I<Color> type for your
609 B<My::Graphics> module, you would call the type
610 I<My::Graphics::Types::Color> instead.
612 =head2 Use with Other Constraint Modules
614 This module can play nicely with other constraint modules with some
615 slight tweaking. The C<where> clause in types is expected to be a
616 C<CODE> reference which checks it's first argument and returns a
617 boolean. Since most constraint modules work in a similar way, it
618 should be simple to adapt them to work with Mouse.
620 For instance, this is how you could use it with
621 L<Declare::Constraints::Simple> to declare a completely new type.
623 type 'HashOfArrayOfObjects',
627 -values => IsArrayRef(IsObject)
631 Here is an example of using L<Test::Deep> and it's non-test
632 related C<eq_deeply> function.
634 type 'ArrayOfHashOfBarsAndRandomNumbers'
637 array_each(subhashof({
639 random_number => ignore()
645 =head2 optimized_constraints -> HashRef[CODE]
647 Returns the simple type constraints that Mouse understands.
653 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
655 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
657 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
659 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
661 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
667 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
673 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
677 L<Moose::Util::TypeConstraints>