Tweaks for type constraints; note that type constrains are overloaded
[gitmo/Mouse.git] / lib / Mouse / Util / TypeConstraints.pm
CommitLineData
3b46bd49 1package Mouse::Util::TypeConstraints;
89681b0b 2use Mouse::Util; # enables strict and warnings
9baf5d6b 3
684db121 4use Mouse::Meta::TypeConstraint;
bc69ee88 5use Mouse::Exporter;
6
9abaecfd 7use Carp ();
8use Scalar::Util ();
9
bc69ee88 10Mouse::Exporter->setup_import_methods(
11 as_is => [qw(
5d4810c1 12 as where message optimize_as
13 from via
ebe91068 14
15 type subtype class_type role_type duck_type
16 enum
17 coerce
18
bc69ee88 19 find_type_constraint
35ce550a 20 register_type_constraint
bc69ee88 21 )],
139d92d2 22);
23
718b5d9b 24our @CARP_NOT = qw(Mouse::Meta::Attribute);
25
cceb0e25 26my %TYPE;
4188b837 27
df448257 28# The root type
29$TYPE{Any} = Mouse::Meta::TypeConstraint->new(
30 name => 'Any',
31);
32
33my @builtins = (
34 # $name => $parent, $code,
35
36 # the base type
37 Item => 'Any', undef,
38
39 # the maybe[] type
40 Maybe => 'Item', undef,
41
42 # value types
43 Undef => 'Item', \&Undef,
44 Defined => 'Item', \&Defined,
45 Bool => 'Item', \&Bool,
46 Value => 'Defined', \&Value,
47 Str => 'Value', \&Str,
48 Num => 'Str', \&Num,
49 Int => 'Num', \&Int,
50
51 # ref types
52 Ref => 'Defined', \&Ref,
53 ScalarRef => 'Ref', \&ScalarRef,
54 ArrayRef => 'Ref', \&ArrayRef,
55 HashRef => 'Ref', \&HashRef,
56 CodeRef => 'Ref', \&CodeRef,
57 RegexpRef => 'Ref', \&RegexpRef,
58 GlobRef => 'Ref', \&GlobRef,
59
60 # object types
61 FileHandle => 'GlobRef', \&FileHandle,
62 Object => 'Ref', \&Object,
63
64 # special string types
65 ClassName => 'Str', \&ClassName,
66 RoleName => 'ClassName', \&RoleName,
67);
68
df448257 69while (my ($name, $parent, $code) = splice @builtins, 0, 3) {
70 $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
71 name => $name,
72 parent => $TYPE{$parent},
73 optimized => $code,
74 );
75}
76
9abaecfd 77# parametarizable types
df448257 78$TYPE{Maybe} {constraint_generator} = \&_parameterize_Maybe_for;
79$TYPE{ArrayRef}{constraint_generator} = \&_parameterize_ArrayRef_for;
80$TYPE{HashRef} {constraint_generator} = \&_parameterize_HashRef_for;
81
82# sugars
a4b15169 83sub as ($) { (as => $_[0]) } ## no critic
84sub where (&) { (where => $_[0]) } ## no critic
85sub message (&) { (message => $_[0]) } ## no critic
86sub optimize_as (&) { (optimize_as => $_[0]) } ## no critic
61a02a3a 87
73766a27 88sub from { @_ }
a4b15169 89sub via (&) { $_[0] } ## no critic
61a02a3a 90
df448257 91# type utilities
993e62a7 92
df448257 93sub optimized_constraints { # DEPRECATED
94 Carp::cluck('optimized_constraints() has been deprecated');
95 return \%TYPE;
96}
d3982c7e 97
df448257 98undef @builtins; # free the allocated memory
99@builtins = keys %TYPE; # reuse it
100sub list_all_builtin_type_constraints { @builtins }
df448257 101sub list_all_type_constraints { keys %TYPE }
993e62a7 102
a3a00648 103sub _define_type {
104 my $is_subtype = shift;
73766a27 105 my $name;
f5ee065f 106 my %args;
73766a27 107
a3a00648 108 if(@_ == 1 && ref $_[0] ){ # @_ : { name => $name, where => ... }
f5ee065f 109 %args = %{$_[0]};
73766a27 110 }
a3a00648 111 elsif(@_ == 2 && ref $_[1]) { # @_ : $name => { where => ... }
73766a27 112 $name = $_[0];
f5ee065f 113 %args = %{$_[1]};
73766a27 114 }
a3a00648 115 elsif(@_ % 2) { # @_ : $name => ( where => ... )
f5ee065f 116 ($name, %args) = @_;
73766a27 117 }
a3a00648 118 else{ # @_ : (name => $name, where => ...)
f5ee065f 119 %args = @_;
73766a27 120 }
121
f5ee065f 122 if(!defined $name){
4f24c598 123 $name = $args{name};
cd2b9201 124 }
d4571def 125
f5ee065f 126 $args{name} = $name;
a3a00648 127
128 my $parent = delete $args{as};
129 if($is_subtype && !$parent){
130 $parent = delete $args{name};
131 $name = undef;
132 }
133
134 if(defined $parent) {
135 $args{parent} = find_or_create_isa_type_constraint($parent);
b8434acc 136 }
7dbebb1b 137
4f24c598 138 if(defined $name){
df448257 139 # set 'package_defined_in' only if it is not a core package
140 my $this = $args{package_defined_in};
141 if(!$this){
142 $this = caller(1);
143 if($this !~ /\A Mouse \b/xms){
144 $args{package_defined_in} = $this;
145 }
146 }
147
f1a8bff3 148 if(defined $TYPE{$name}){
df448257 149 my $that = $TYPE{$name}->{package_defined_in} || __PACKAGE__;
b6f6f7b2 150 if($this ne $that) {
151 my $note = '';
152 if($that eq __PACKAGE__) {
153 $note = sprintf " ('%s' is %s type constraint)",
154 $name,
155 scalar(grep { $name eq $_ } list_all_builtin_type_constraints())
156 ? 'a builtin'
157 : 'an implicitly created';
158 }
159 Carp::croak("The type constraint '$name' has already been created in $that"
160 . " and cannot be created again in $this" . $note);
161 }
4f24c598 162 }
163 }
d4571def 164
b8434acc 165 $args{constraint} = delete $args{where} if exists $args{where};
24410e3a 166 $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as};
0d9fea22 167
a3a00648 168 my $constraint = Mouse::Meta::TypeConstraint->new(%args);
7dbebb1b 169
4f24c598 170 if(defined $name){
171 return $TYPE{$name} = $constraint;
172 }
173 else{
174 return $constraint;
175 }
f5ee065f 176}
7dbebb1b 177
f5ee065f 178sub type {
a3a00648 179 return _define_type 0, @_;
f5ee065f 180}
d4571def 181
f5ee065f 182sub subtype {
a3a00648 183 return _define_type 1, @_;
4188b837 184}
185
9abaecfd 186sub coerce { # coerce $type, from $from, via { ... }, ...
ffbbf459 187 my $type_name = shift;
ffbbf459 188 my $type = find_type_constraint($type_name)
718b5d9b 189 or Carp::croak("Cannot find type '$type_name', perhaps you forgot to load it.");
61a02a3a 190
ffbbf459 191 $type->_add_type_coercions(@_);
cd2b9201 192 return;
4188b837 193}
194
139d92d2 195sub class_type {
337e3b0c 196 my($name, $options) = @_;
197 my $class = $options->{class} || $name;
df448257 198
199 # ClassType
f1a8bff3 200 return subtype $name => (
ddbad0b1 201 as => 'Object',
e3540312 202 optimized_as => Mouse::Util::generate_isa_predicate_for($class),
a3a00648 203 class => $class,
337e3b0c 204 );
ecc6e3b1 205}
206
139d92d2 207sub role_type {
337e3b0c 208 my($name, $options) = @_;
209 my $role = $options->{role} || $name;
df448257 210
211 # RoleType
f1a8bff3 212 return subtype $name => (
1d5ecd5f 213 as => 'Object',
89681b0b 214 optimized_as => sub {
215 return Scalar::Util::blessed($_[0])
216 && Mouse::Util::does_role($_[0], $role);
217 },
a3a00648 218 role => $role,
61a02a3a 219 );
47f36c05 220}
221
ebe91068 222sub duck_type {
223 my($name, @methods);
224
5a592ad7 225 if(ref($_[0]) ne 'ARRAY'){
ebe91068 226 $name = shift;
227 }
228
229 @methods = (@_ == 1 && ref($_[0]) eq 'ARRAY') ? @{$_[0]} : @_;
230
df448257 231 # DuckType
a3a00648 232 return _define_type 1, $name => (
188ff28f 233 as => 'Object',
ebe91068 234 optimized_as => Mouse::Util::generate_can_predicate_for(\@methods),
5a592ad7 235 message => sub {
236 my($object) = @_;
237 my @missing = grep { !$object->can($_) } @methods;
238 return ref($object)
239 . ' is missing methods '
240 . Mouse::Util::quoted_english_list(@missing);
241 },
a3a00648 242 methods => \@methods,
ebe91068 243 );
244}
245
d44f0d03 246sub enum {
f5ee065f 247 my($name, %valid);
248
f152b099 249 if(!(@_ == 1 && ref($_[0]) eq 'ARRAY')){
250 $name = shift;
f5ee065f 251 }
f152b099 252
89681b0b 253 %valid = map{ $_ => undef }
254 (@_ == 1 && ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_);
f152b099 255
df448257 256 # EnumType
a3a00648 257 return _define_type 1, $name => (
188ff28f 258 as => 'Str',
89681b0b 259 optimized_as => sub{
260 return defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]};
261 },
f5ee065f 262 );
263}
264
265sub _find_or_create_regular_type{
718b5d9b 266 my($spec, $create) = @_;
f5ee065f 267
268 return $TYPE{$spec} if exists $TYPE{$spec};
01904723 269
718b5d9b 270 my $meta = Mouse::Util::get_metaclass_by_name($spec);
271
272 if(!defined $meta){
273 return $create ? class_type($spec) : undef;
274 }
01904723 275
f48920c1 276 if(Mouse::Util::is_a_metarole($meta)){
1d5ecd5f 277 return role_type($spec);
f5ee065f 278 }
279 else{
1d5ecd5f 280 return class_type($spec);
f5ee065f 281 }
d44f0d03 282}
283
f5ee065f 284sub _find_or_create_parameterized_type{
285 my($base, $param) = @_;
286
287 my $name = sprintf '%s[%s]', $base->name, $param->name;
288
b4d791ba 289 $TYPE{$name} ||= $base->parameterize($param, $name);
f5ee065f 290}
b4d791ba 291
f5ee065f 292sub _find_or_create_union_type{
718b5d9b 293 return if grep{ not defined } @_;
a2f1294a 294 my @types = sort map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
f5ee065f 295
30b28db3 296 my $name = join '|', @types;
f5ee065f 297
df448257 298 # UnionType
b4d791ba 299 $TYPE{$name} ||= Mouse::Meta::TypeConstraint->new(
300 name => $name,
301 type_constraints => \@types,
b4d791ba 302 );
f5ee065f 303}
304
305# The type parser
f5ee065f 306
718b5d9b 307# param : '[' type ']' | NOTHING
308sub _parse_param {
309 my($c) = @_;
f5ee065f 310
718b5d9b 311 if($c->{spec} =~ s/^\[//){
312 my $type = _parse_type($c, 1);
f5ee065f 313
718b5d9b 314 if($c->{spec} =~ s/^\]//){
315 return $type;
321e5271 316 }
718b5d9b 317 Carp::croak("Syntax error in type: missing right square bracket in '$c->{orig}'");
318 }
57f0e313 319
718b5d9b 320 return undef;
321}
f5ee065f 322
718b5d9b 323# name : [\w.:]+
324sub _parse_name {
325 my($c, $create) = @_;
f5ee065f 326
718b5d9b 327 if($c->{spec} =~ s/\A ([\w.:]+) //xms){
328 return _find_or_create_regular_type($1, $create);
329 }
330 Carp::croak("Syntax error in type: expect type name near '$c->{spec}' in '$c->{orig}'");
331}
f5ee065f 332
718b5d9b 333# single_type : name param
334sub _parse_single_type {
335 my($c, $create) = @_;
f5ee065f 336
718b5d9b 337 my $type = _parse_name($c, $create);
338 my $param = _parse_param($c);
29376895 339
718b5d9b 340 if(defined $type){
341 if(defined $param){
342 return _find_or_create_parameterized_type($type, $param);
29376895 343 }
718b5d9b 344 else {
345 return $type;
29376895 346 }
f5ee065f 347 }
718b5d9b 348 elsif(defined $param){
349 Carp::croak("Undefined type with parameter [$param] in '$c->{orig}'");
993e62a7 350 }
351 else{
718b5d9b 352 return undef;
993e62a7 353 }
321e5271 354}
355
718b5d9b 356# type : single_type ('|' single_type)*
357sub _parse_type {
358 my($c, $create) = @_;
359
360 my $type = _parse_single_type($c, $create);
361 if($c->{spec}){ # can be an union type
362 my @types;
363 while($c->{spec} =~ s/^\|//){
364 push @types, _parse_single_type($c, $create);
365 }
366 if(@types){
367 return _find_or_create_union_type($type, @types);
368 }
369 }
370 return $type;
371}
372
f5ee065f 373
374sub find_type_constraint {
375 my($spec) = @_;
7712ea96 376 return $spec if Mouse::Util::is_a_type_constraint($spec) or not defined $spec;
f5ee065f 377
378 $spec =~ s/\s+//g;
379 return $TYPE{$spec};
2efc0af1 380}
381
35ce550a 382sub register_type_constraint {
383 my($constraint) = @_;
384 Carp::croak("No type supplied / type is not a valid type constraint")
385 unless Mouse::Util::is_a_type_constraint($constraint);
386 my $name = $constraint->name;
a3a00648 387 Carp::croak("Can't register an unnamed type constraint")
35ce550a 388 unless defined $name;
389 return $TYPE{$name} = $constraint;
390}
391
f5ee065f 392sub find_or_parse_type_constraint {
393 my($spec) = @_;
7712ea96 394 return $spec if Mouse::Util::is_a_type_constraint($spec) or not defined $spec;
9c85e9dc 395
74c6212d 396 $spec =~ tr/ \t\r\n//d;
397
398 my $tc = $TYPE{$spec};
399 if(defined $tc) {
400 return $tc;
401 }
402
403 my %context = (
404 spec => $spec,
405 orig => $spec,
406 );
407 $tc = _parse_type(\%context);
408
409 if($context{spec}){
410 Carp::croak("Syntax error: extra elements '$context{spec}' in '$context{orig}'");
411 }
412
413 return $TYPE{$spec} = $tc;
f5ee065f 414}
321e5271 415
f5ee065f 416sub find_or_create_does_type_constraint{
ddbad0b1 417 # XXX: Moose does not register a new role_type, but Mouse does.
74c6212d 418 my $tc = find_or_parse_type_constraint(@_);
419 return defined($tc) ? $tc : role_type(@_);
f5ee065f 420}
421
422sub find_or_create_isa_type_constraint {
ddbad0b1 423 # XXX: Moose does not register a new class_type, but Mouse does.
74c6212d 424 my $tc = find_or_parse_type_constraint(@_);
425 return defined($tc) ? $tc : class_type(@_);
321e5271 426}
427
d60c78b9 4281;
6feb83f1 429__END__
430
431=head1 NAME
432
5893ee36 433Mouse::Util::TypeConstraints - Type constraint system for Mouse
434
a25ca8d6 435=head1 VERSION
436
999072ab 437This document describes Mouse version 0.82
a25ca8d6 438
5893ee36 439=head2 SYNOPSIS
440
441 use Mouse::Util::TypeConstraints;
442
443 subtype 'Natural'
444 => as 'Int'
445 => where { $_ > 0 };
446
447 subtype 'NaturalLessThanTen'
448 => as 'Natural'
449 => where { $_ < 10 }
450 => message { "This number ($_) is not less than ten!" };
451
452 coerce 'Num'
453 => from 'Str'
454 => via { 0+$_ };
455
456 enum 'RGBColors' => qw(red green blue);
457
458 no Mouse::Util::TypeConstraints;
459
460=head1 DESCRIPTION
461
462This module provides Mouse with the ability to create custom type
463constraints to be used in attribute definition.
464
465=head2 Important Caveat
466
467This is B<NOT> a type system for Perl 5. These are type constraints,
468and they are not used by Mouse unless you tell it to. No type
469inference is performed, expressions are not typed, etc. etc. etc.
470
471A type constraint is at heart a small "check if a value is valid"
472function. A constraint can be associated with an attribute. This
473simplifies parameter validation, and makes your code clearer to read,
474because you can refer to constraints by name.
475
476=head2 Slightly Less Important Caveat
477
478It is B<always> a good idea to quote your type names.
479
480This prevents Perl from trying to execute the call as an indirect
481object call. This can be an issue when you have a subtype with the
482same name as a valid class.
483
484For instance:
485
486 subtype DateTime => as Object => where { $_->isa('DateTime') };
487
488will I<just work>, while this:
489
490 use DateTime;
491 subtype DateTime => as Object => where { $_->isa('DateTime') };
492
493will fail silently and cause many headaches. The simple way to solve
494this, as well as future proof your subtypes from classes which have
495yet to have been created, is to quote the type name:
496
497 use DateTime;
498 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
499
500=head2 Default Type Constraints
501
502This module also provides a simple hierarchy for Perl 5 types, here is
503that hierarchy represented visually.
504
dba2e142 505 Any
5893ee36 506 Item
507 Bool
508 Maybe[`a]
509 Undef
510 Defined
511 Value
5893ee36 512 Str
dba2e142 513 Num
514 Int
515 ClassName
516 RoleName
5893ee36 517 Ref
518 ScalarRef
519 ArrayRef[`a]
520 HashRef[`a]
521 CodeRef
522 RegexpRef
523 GlobRef
dba2e142 524 FileHandle
5893ee36 525 Object
5893ee36 526
527B<NOTE:> Any type followed by a type parameter C<[`a]> can be
528parameterized, this means you can say:
529
530 ArrayRef[Int] # an array of integers
531 HashRef[CodeRef] # a hash of str to CODE ref mappings
532 Maybe[Str] # value may be a string, may be undefined
533
534If Mouse finds a name in brackets that it does not recognize as an
535existing type, it assumes that this is a class name, for example
536C<ArrayRef[DateTime]>.
537
5893ee36 538B<NOTE:> The C<Undef> type constraint for the most part works
539correctly now, but edge cases may still exist, please use it
540sparingly.
541
542B<NOTE:> The C<ClassName> type constraint does a complex package
543existence check. This means that your class B<must> be loaded for this
544type constraint to pass.
545
546B<NOTE:> The C<RoleName> constraint checks a string is a I<package
547name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
548constraint checks that an I<object does> the named role.
549
550=head2 Type Constraint Naming
551
552Type name declared via this module can only contain alphanumeric
553characters, colons (:), and periods (.).
554
555Since the types created by this module are global, it is suggested
556that you namespace your types just as you would namespace your
557modules. So instead of creating a I<Color> type for your
558B<My::Graphics> module, you would call the type
559I<My::Graphics::Types::Color> instead.
560
561=head2 Use with Other Constraint Modules
562
563This module can play nicely with other constraint modules with some
564slight tweaking. The C<where> clause in types is expected to be a
565C<CODE> reference which checks it's first argument and returns a
566boolean. Since most constraint modules work in a similar way, it
567should be simple to adapt them to work with Mouse.
568
569For instance, this is how you could use it with
570L<Declare::Constraints::Simple> to declare a completely new type.
571
572 type 'HashOfArrayOfObjects',
573 {
574 where => IsHashRef(
575 -keys => HasLength,
576 -values => IsArrayRef(IsObject)
577 )
578 };
579
580Here is an example of using L<Test::Deep> and it's non-test
581related C<eq_deeply> function.
582
583 type 'ArrayOfHashOfBarsAndRandomNumbers'
584 => where {
585 eq_deeply($_,
586 array_each(subhashof({
587 bar => isa('Bar'),
588 random_number => ignore()
589 })))
590 };
6feb83f1 591
592=head1 METHODS
593
24410e3a 594=head2 C<< list_all_builtin_type_constraints -> (Names) >>
6feb83f1 595
24410e3a 596Returns the names of builtin type constraints.
597
598=head2 C<< list_all_type_constraints -> (Names) >>
599
600Returns the names of all the type constraints.
6feb83f1 601
c91d12e0 602=head1 FUNCTIONS
603
604=over 4
605
c9cc6884 606=item C<< type $name => where { } ... -> Mouse::Meta::TypeConstraint >>
c91d12e0 607
c9cc6884 608=item C<< subtype $name => as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
609
610=item C<< subtype as $parent => where { } ... -> Mouse::Meta::TypeConstraint >>
c91d12e0 611
1820fffe 612=item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >>
c91d12e0 613
1820fffe 614=item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >>
c91d12e0 615
c9cc6884 616=item C<< duck_type($name, @methods | \@methods) -> Mouse::Meta::TypeConstraint >>
617
618=item C<< duck_type(\@methods) -> Mouse::Meta::TypeConstraint >>
619
620=item C<< enum($name, @values | \@values) -> Mouse::Meta::TypeConstraint >>
621
1820fffe 622=item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >>
623
87f1f3d2 624=item C<< coerce $type => from $another_type, via { }, ... >>
625
1820fffe 626=back
627
628=over 4
629
630=item C<< find_type_constraint(Type) -> Mouse::Meta::TypeConstraint >>
c91d12e0 631
632=back
633
5893ee36 634=head1 THANKS
635
1820fffe 636Much of this documentation was taken from C<Moose::Util::TypeConstraints>
637
638=head1 SEE ALSO
639
640L<Moose::Util::TypeConstraints>
5893ee36 641
6feb83f1 642=cut
643
644