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 our @ISA = qw(Exporter);
16 as where message from via type subtype coerce class_type role_type enum
29 return(where => $_[0])
32 return(message => $_[0])
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(
74 _compiled_type_constraint => $code,
76 $TYPE_SOURCE{$name} = __PACKAGE__;
79 sub optimized_constraints { \%TYPE }
81 my @builtins = keys %TYPE;
82 sub list_all_builtin_type_constraints { @builtins }
84 sub list_all_type_constraints { keys %TYPE }
91 if(@_ == 1 && ref $_[0]){ # type { where => ... }
94 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
98 elsif(@_ % 2){ # odd number of arguments
106 $name = '__ANON__' if !defined $name;
110 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
111 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
114 my $constraint = $conf{where} || do {
115 my $as = delete $conf{as} || 'Any';
116 ($TYPE{$as} ||= _build_type_constraint($as))->{_compiled_type_constraint};
119 my $tc = Mouse::Meta::TypeConstraint->new(
121 _compiled_type_constraint => sub {
123 return &{$constraint};
127 $TYPE_SOURCE{$name} = $pkg;
137 if(@_ == 1 && ref $_[0]){ # type { where => ... }
140 elsif(@_ == 2 && ref $_[1]){ # type $name => { where => ... }*
144 elsif(@_ % 2){ # odd number of arguments
152 $name = '__ANON__' if !defined $name;
154 my $pkg = caller($conf{_caller_level} || 1);
156 if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
157 Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
160 my $constraint = delete $conf{where};
161 my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any')
162 ->{_compiled_type_constraint};
164 my $tc = Mouse::Meta::TypeConstraint->new(
166 _compiled_type_constraint => (
170 $as_constraint->($_[0]) && $constraint->($_[0])
174 $as_constraint->($_[0]);
180 $TYPE_SOURCE{$name} = $pkg;
189 Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
192 unless ($COERCE{$name}) {
194 $COERCE_KEYS{$name} = [];
197 while (my($type, $code) = splice @_, 0, 2) {
198 Carp::croak "A coercion action already exists for '$type'"
199 if $COERCE{$name}->{$type};
201 if (! $TYPE{$type}) {
202 # looks parameterized
203 if ($type =~ /^[^\[]+\[.+\]$/) {
204 $TYPE{$type} = _build_type_constraint($type);
206 Carp::croak "Could not find the type constraint ($type) to coerce from"
210 push @{ $COERCE_KEYS{$name} }, $type;
211 $COERCE{$name}->{$type} = $code;
217 my($name, $conf) = @_;
218 if ($conf && $conf->{class}) {
219 # No, you're using this wrong
220 warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
222 as => $conf->{class},
223 caller_level => (($conf->{_caller_level}||0) + 1),
228 where => sub { blessed($_) && $_->isa($name) },
229 caller_level => (($conf->{_caller_level}||0) + 1),
235 my($name, $conf) = @_;
236 my $role = $conf->{role};
238 where => sub { does_role($_, $role) },
239 caller_level => (($conf->{_caller_level}||0) + 1),
243 # this is an original method for Mouse
244 sub typecast_constraints {
245 my($class, $pkg, $types, $value) = @_;
246 Carp::croak("wrong arguments count") unless @_ == 4;
249 for my $type ( split /\|/, $types ) {
250 next unless $COERCE{$type};
251 for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
253 next unless $TYPE{$coerce_type}->check($value);
255 $_ = $COERCE{$type}->{$coerce_type}->($value);
256 return $_ if $types->check($_);
264 # enum ['small', 'medium', 'large']
265 if (ref($_[0]) eq 'ARRAY') {
266 my @elements = @{ shift @_ };
268 my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
270 enum($name, @elements);
274 # enum size => 'small', 'medium', 'large'
276 my %is_valid = map { $_ => 1 } @_;
279 where => sub { $is_valid{$_} },
284 sub _build_type_constraint {
290 if ($spec =~ /\A (\w+) \[ (.+) \] \z/xms) {
296 if ($constraint eq 'Maybe') {
297 $parent = _build_type_constraint('Undef');
300 $parent = _build_type_constraint($constraint);
302 my $child = _build_type_constraint($param);
303 if ($constraint eq 'ArrayRef') {
305 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
307 " if (\$parent->check(\$_[0])) {\n" .
308 " foreach my \$e (\@{\$_[0]}) {\n" .
309 " return () unless \$child->check(\$e);\n" .
316 $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
317 } elsif ($constraint eq 'HashRef') {
319 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
321 " if (\$parent->check(\$_[0])) {\n" .
322 " foreach my \$e (values \%{\$_[0]}) {\n" .
323 " return () unless \$child->check(\$e);\n" .
330 $code = eval $code_str or Carp::confess($@);
331 } elsif ($constraint eq 'Maybe') {
333 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
335 " return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
338 $code = eval $code_str or Carp::confess($@);
340 Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
342 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
344 $code = $TYPE{ $spec };
346 # is $spec a known role? If so, constrain with 'does' instead of 'isa'
347 require Mouse::Meta::Role;
348 my $check = Mouse::Meta::Role->_metaclass_cache($spec)?
351 "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
353 " Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
356 $code = eval $code_str or Carp::confess($@);
357 $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
360 return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
363 sub find_type_constraint {
365 if(blessed($type) && $type->isa('Mouse::Meta::TypeConstraint')){
373 sub find_or_create_does_type_constraint{
377 sub find_or_create_isa_type_constraint {
378 my $type_constraint = shift;
380 Carp::confess("Got isa => type_constraints, but Mouse does not yet support parameterized types for containers other than ArrayRef and HashRef and Maybe (rt.cpan.org #39795)")
381 if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
388 $type_constraint =~ s/\s+//g;
390 my $tc = find_type_constraint($type_constraint);
392 my @type_constraints = split /\|/, $type_constraint;
393 if (@type_constraints == 1) {
394 $tc = $TYPE{$type_constraints[0]} ||
395 _build_type_constraint($type_constraints[0]);
398 my @code_list = map {
399 $TYPE{$_} || _build_type_constraint($_)
402 $tc = Mouse::Meta::TypeConstraint->new(
403 name => $type_constraint,
405 _compiled_type_constraint => sub {
406 foreach my $code (@code_list) {
407 return 1 if $code->check($_[0]);
423 Mouse::Util::TypeConstraints - Type constraint system for Mouse
427 use Mouse::Util::TypeConstraints;
433 subtype 'NaturalLessThanTen'
436 => message { "This number ($_) is not less than ten!" };
442 enum 'RGBColors' => qw(red green blue);
444 no Mouse::Util::TypeConstraints;
448 This module provides Mouse with the ability to create custom type
449 constraints to be used in attribute definition.
451 =head2 Important Caveat
453 This is B<NOT> a type system for Perl 5. These are type constraints,
454 and they are not used by Mouse unless you tell it to. No type
455 inference is performed, expressions are not typed, etc. etc. etc.
457 A type constraint is at heart a small "check if a value is valid"
458 function. A constraint can be associated with an attribute. This
459 simplifies parameter validation, and makes your code clearer to read,
460 because you can refer to constraints by name.
462 =head2 Slightly Less Important Caveat
464 It is B<always> a good idea to quote your type names.
466 This prevents Perl from trying to execute the call as an indirect
467 object call. This can be an issue when you have a subtype with the
468 same name as a valid class.
472 subtype DateTime => as Object => where { $_->isa('DateTime') };
474 will I<just work>, while this:
477 subtype DateTime => as Object => where { $_->isa('DateTime') };
479 will fail silently and cause many headaches. The simple way to solve
480 this, as well as future proof your subtypes from classes which have
481 yet to have been created, is to quote the type name:
484 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
486 =head2 Default Type Constraints
488 This module also provides a simple hierarchy for Perl 5 types, here is
489 that hierarchy represented visually.
514 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
515 parameterized, this means you can say:
517 ArrayRef[Int] # an array of integers
518 HashRef[CodeRef] # a hash of str to CODE ref mappings
519 Maybe[Str] # value may be a string, may be undefined
521 If Mouse finds a name in brackets that it does not recognize as an
522 existing type, it assumes that this is a class name, for example
523 C<ArrayRef[DateTime]>.
525 B<NOTE:> Unless you parameterize a type, then it is invalid to include
526 the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
527 name, I<not> as a parameterization of C<ArrayRef>.
529 B<NOTE:> The C<Undef> type constraint for the most part works
530 correctly now, but edge cases may still exist, please use it
533 B<NOTE:> The C<ClassName> type constraint does a complex package
534 existence check. This means that your class B<must> be loaded for this
535 type constraint to pass.
537 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
538 name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
539 constraint checks that an I<object does> the named role.
541 =head2 Type Constraint Naming
543 Type name declared via this module can only contain alphanumeric
544 characters, colons (:), and periods (.).
546 Since the types created by this module are global, it is suggested
547 that you namespace your types just as you would namespace your
548 modules. So instead of creating a I<Color> type for your
549 B<My::Graphics> module, you would call the type
550 I<My::Graphics::Types::Color> instead.
552 =head2 Use with Other Constraint Modules
554 This module can play nicely with other constraint modules with some
555 slight tweaking. The C<where> clause in types is expected to be a
556 C<CODE> reference which checks it's first argument and returns a
557 boolean. Since most constraint modules work in a similar way, it
558 should be simple to adapt them to work with Mouse.
560 For instance, this is how you could use it with
561 L<Declare::Constraints::Simple> to declare a completely new type.
563 type 'HashOfArrayOfObjects',
567 -values => IsArrayRef(IsObject)
571 Here is an example of using L<Test::Deep> and it's non-test
572 related C<eq_deeply> function.
574 type 'ArrayOfHashOfBarsAndRandomNumbers'
577 array_each(subhashof({
579 random_number => ignore()
585 =head2 optimized_constraints -> HashRef[CODE]
587 Returns the simple type constraints that Mouse understands.
593 =item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
595 =item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >>
597 =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
599 =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
601 =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
607 =item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
613 Much of this documentation was taken from C<Moose::Util::TypeConstraints>
617 L<Moose::Util::TypeConstraints>