Use Class::MOP::get_meta($thing) instead of $thing->meta
[gitmo/Moose.git] / lib / Moose / Util / TypeConstraints.pm
CommitLineData
a15dff8d 1
2package Moose::Util::TypeConstraints;
3
4use strict;
5use warnings;
6
998a8a25 7use Carp ();
e3979c3e 8use List::MoreUtils qw( all );
21f1e231 9use Scalar::Util 'blessed';
e606ae5f 10use Moose::Exporter;
a15dff8d 11
1aab4011 12our $VERSION = '0.64';
e606ae5f 13$VERSION = eval $VERSION;
d44714be 14our $AUTHORITY = 'cpan:STEVAN';
a15dff8d 15
d9b40005 16## --------------------------------------------------------
e85d2a5d 17# Prototyped subs must be predeclared because we have a
18# circular dependency with Moose::Meta::Attribute et. al.
19# so in case of us being use'd first the predeclaration
d9b40005 20# ensures the prototypes are in scope when consumers are
21# compiled.
22
d9b40005 23# dah sugah!
d9b40005 24sub where (&);
25sub via (&);
26sub message (&);
27sub optimize_as (&);
d9b40005 28
e85d2a5d 29## private stuff ...
d9b40005 30sub _create_type_constraint ($$$;$$);
31sub _install_type_coercions ($$);
32
33## --------------------------------------------------------
8c4acc60 34
4e036ee4 35use Moose::Meta::TypeConstraint;
3726f905 36use Moose::Meta::TypeConstraint::Union;
0fbd4b0a 37use Moose::Meta::TypeConstraint::Parameterized;
7e4e1ad4 38use Moose::Meta::TypeConstraint::Parameterizable;
620db045 39use Moose::Meta::TypeConstraint::Class;
40use Moose::Meta::TypeConstraint::Role;
dabed765 41use Moose::Meta::TypeConstraint::Enum;
2ca63f5d 42use Moose::Meta::TypeCoercion;
3726f905 43use Moose::Meta::TypeCoercion::Union;
22aed3c0 44use Moose::Meta::TypeConstraint::Registry;
28ffb449 45use Moose::Util::TypeConstraints::OptimizedConstraints;
4e036ee4 46
e606ae5f 47Moose::Exporter->setup_import_methods(
48 as_is => [
49 qw(
50 type subtype class_type role_type as where message optimize_as
51 coerce from via
52 enum
53 find_type_constraint
54 register_type_constraint )
55 ],
56 _export_to_main => 1,
57);
a15dff8d 58
d9b40005 59## --------------------------------------------------------
60## type registry and some useful functions for it
61## --------------------------------------------------------
62
22aed3c0 63my $REGISTRY = Moose::Meta::TypeConstraint::Registry->new;
587ae0d2 64
d9b40005 65sub get_type_constraint_registry { $REGISTRY }
e85d2a5d 66sub list_all_type_constraints { keys %{$REGISTRY->type_constraints} }
d9b40005 67sub export_type_constraints_as_functions {
68 my $pkg = caller();
69 no strict 'refs';
a0f8153d 70 foreach my $constraint (keys %{$REGISTRY->type_constraints}) {
42bc21a4 71 my $tc = $REGISTRY->get_type_constraint($constraint)->_compiled_type_constraint;
d2f0f6e9 72 *{"${pkg}::${constraint}"} = sub { $tc->($_[0]) ? 1 : undef }; # the undef is for compat
a0f8153d 73 }
d9b40005 74}
182134e8 75
0c015f1b 76sub create_type_constraint_union {
d9b40005 77 my @type_constraint_names;
e85d2a5d 78
f1917f58 79 if (scalar @_ == 1 && _detect_type_constraint_union($_[0])) {
80 @type_constraint_names = _parse_type_constraint_union($_[0]);
d9b40005 81 }
82 else {
83 @type_constraint_names = @_;
429ccc11 84 }
eb4c4e82 85
3726f905 86 (scalar @type_constraint_names >= 2)
c245d69b 87 || Moose->throw_error("You must pass in at least 2 type names to make a union");
e85d2a5d 88
84a9c64c 89 my @type_constraints = map {
08380fdb 90 find_or_parse_type_constraint($_) ||
fa92d705 91 Moose->throw_error("Could not locate type constraint ($_) for the union");
08380fdb 92 } @type_constraint_names;
84a9c64c 93
3726f905 94 return Moose::Meta::TypeConstraint::Union->new(
fa92d705 95 type_constraints => \@type_constraints
e85d2a5d 96 );
182134e8 97}
a15dff8d 98
0c015f1b 99sub create_parameterized_type_constraint {
d9b40005 100 my $type_constraint_name = shift;
98407b93 101 my ($base_type, $type_parameter) = _parse_parameterized_type_constraint($type_constraint_name);
e85d2a5d 102
98407b93 103 (defined $base_type && defined $type_parameter)
c245d69b 104 || Moose->throw_error("Could not parse type name ($type_constraint_name) correctly");
e85d2a5d 105
90e78884 106 if ($REGISTRY->has_type_constraint($base_type)) {
107 my $base_type_tc = $REGISTRY->get_type_constraint($base_type);
108 return _create_parameterized_type_constraint(
109 $base_type_tc,
110 $type_parameter
111 );
112 } else {
113 Moose->throw_error("Could not locate the base type ($base_type)");
114 }
22aed3c0 115}
116
90e78884 117sub _create_parameterized_type_constraint {
118 my ( $base_type_tc, $type_parameter ) = @_;
119 if ( $base_type_tc->can('parameterize') ) {
120 return $base_type_tc->parameterize($type_parameter);
121 } else {
122 return Moose::Meta::TypeConstraint::Parameterized->new(
123 name => $base_type_tc->name . '[' . $type_parameter . ']',
124 parent => $base_type_tc,
125 type_parameter => find_or_create_isa_type_constraint($type_parameter),
126 );
127 }
128}
129
4ab662d6 130#should we also support optimized checks?
0c015f1b 131sub create_class_type_constraint {
620db045 132 my ( $class, $options ) = @_;
133
3fef8ce8 134 # too early for this check
135 #find_type_constraint("ClassName")->check($class)
c245d69b 136 # || Moose->throw_error("Can't create a class type constraint because '$class' is not a class name");
3fef8ce8 137
620db045 138 my %options = (
139 class => $class,
140 name => $class,
141 %{ $options || {} },
4ab662d6 142 );
620db045 143
144 $options{name} ||= "__ANON__";
145
146 Moose::Meta::TypeConstraint::Class->new( %options );
3fef8ce8 147}
148
0c015f1b 149sub create_role_type_constraint {
620db045 150 my ( $role, $options ) = @_;
e85d2a5d 151
620db045 152 # too early for this check
153 #find_type_constraint("ClassName")->check($class)
c245d69b 154 # || Moose->throw_error("Can't create a class type constraint because '$class' is not a class name");
e85d2a5d 155
620db045 156 my %options = (
157 role => $role,
158 name => $role,
159 %{ $options || {} },
160 );
e85d2a5d 161
620db045 162 $options{name} ||= "__ANON__";
163
164 Moose::Meta::TypeConstraint::Role->new( %options );
165}
166
167
0c015f1b 168sub find_or_create_type_constraint {
620db045 169 my ( $type_constraint_name, $options_for_anon_type ) = @_;
170
171 if ( my $constraint = find_or_parse_type_constraint($type_constraint_name) ) {
172 return $constraint;
d9b40005 173 }
620db045 174 elsif ( defined $options_for_anon_type ) {
d9b40005 175 # NOTE:
4ab662d6 176 # if there is no $options_for_anon_type
177 # specified, then we assume they don't
f3c4e20e 178 # want to create one, and return nothing.
f3c4e20e 179
d9b40005 180 # otherwise assume that we should create
e85d2a5d 181 # an ANON type with the $options_for_anon_type
d9b40005 182 # options which can be passed in. It should
e85d2a5d 183 # be noted that these don't get registered
d9b40005 184 # so we need to return it.
185 # - SL
186 return Moose::Meta::TypeConstraint->new(
187 name => '__ANON__',
e85d2a5d 188 %{$options_for_anon_type}
d9b40005 189 );
190 }
e85d2a5d 191
620db045 192 return;
193}
194
0c015f1b 195sub find_or_create_isa_type_constraint {
620db045 196 my $type_constraint_name = shift;
5e2ada84 197 find_or_parse_type_constraint($type_constraint_name) || create_class_type_constraint($type_constraint_name)
620db045 198}
199
0c015f1b 200sub find_or_create_does_type_constraint {
620db045 201 my $type_constraint_name = shift;
5e2ada84 202 find_or_parse_type_constraint($type_constraint_name) || create_role_type_constraint($type_constraint_name)
620db045 203}
204
0c015f1b 205sub find_or_parse_type_constraint {
eb4c4e82 206 my $type_constraint_name = normalize_type_constraint_name(shift);
620db045 207 my $constraint;
e606ae5f 208
209 if ($constraint = find_type_constraint($type_constraint_name)) {
210 return $constraint;
211 } elsif (_detect_type_constraint_union($type_constraint_name)) {
620db045 212 $constraint = create_type_constraint_union($type_constraint_name);
08380fdb 213 } elsif (_detect_parameterized_type_constraint($type_constraint_name)) {
620db045 214 $constraint = create_parameterized_type_constraint($type_constraint_name);
215 } else {
216 return;
217 }
bb6c8335 218
d9b40005 219 $REGISTRY->add_type_constraint($constraint);
e85d2a5d 220 return $constraint;
d9b40005 221}
22aed3c0 222
eb4c4e82 223sub normalize_type_constraint_name {
84a9c64c 224 my $type_constraint_name = shift;
c8f663b2 225 $type_constraint_name =~ s/\s//g;
eb4c4e82 226 return $type_constraint_name;
227}
228
5f223879 229sub _confess {
230 my $error = shift;
231
232 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
233 Carp::confess($error);
234}
235
22aed3c0 236## --------------------------------------------------------
237## exported functions ...
238## --------------------------------------------------------
239
0c015f1b 240sub find_type_constraint {
eeedfc8a 241 my $type = shift;
242
243 if ( blessed $type and $type->isa("Moose::Meta::TypeConstraint") ) {
244 return $type;
e606ae5f 245 }
246 else {
247 return unless $REGISTRY->has_type_constraint($type);
eeedfc8a 248 return $REGISTRY->get_type_constraint($type);
249 }
250}
22aed3c0 251
0c015f1b 252sub register_type_constraint {
3fef8ce8 253 my $constraint = shift;
c245d69b 254 Moose->throw_error("can't register an unnamed type constraint") unless defined $constraint->name;
3fef8ce8 255 $REGISTRY->add_type_constraint($constraint);
dabed765 256 return $constraint;
3fef8ce8 257}
258
7c13858b 259# type constructors
a15dff8d 260
9c27968f 261sub type {
1b7df21f 262 splice(@_, 1, 0, undef);
a0f8153d 263 goto &_create_type_constraint;
a15dff8d 264}
265
9c27968f 266sub subtype {
86629f93 267 # NOTE:
268 # this adds an undef for the name
269 # if this is an anon-subtype:
270 # subtype(Num => where { $_ % 2 == 0 }) # anon 'even' subtype
e3979c3e 271 # or
272 # subtype(Num => where { $_ % 2 == 0 }) message { "$_ must be an even number" }
273 #
274 # but if the last arg is not a code ref then it is a subtype
275 # alias:
276 #
86629f93 277 # subtype(MyNumbers => as Num); # now MyNumbers is the same as Num
e85d2a5d 278 # ... yeah I know it's ugly code
86629f93 279 # - SL
e3979c3e 280 unshift @_ => undef if scalar @_ == 2 && ( 'CODE' eq ref( $_[-1] ) );
281 unshift @_ => undef
282 if scalar @_ == 3 && all { ref($_) =~ /^(?:CODE|HASH)$/ } @_[ 1, 2 ];
a0f8153d 283 goto &_create_type_constraint;
a15dff8d 284}
285
9c27968f 286sub class_type {
4ab662d6 287 register_type_constraint(
288 create_class_type_constraint(
289 $_[0],
290 ( defined($_[1]) ? $_[1] : () ),
291 )
292 );
3fef8ce8 293}
294
620db045 295sub role_type ($;$) {
296 register_type_constraint(
297 create_role_type_constraint(
298 $_[0],
299 ( defined($_[1]) ? $_[1] : () ),
300 )
301 );
302}
303
9c27968f 304sub coerce {
e85d2a5d 305 my ($type_name, @coercion_map) = @_;
7c13858b 306 _install_type_coercions($type_name, \@coercion_map);
182134e8 307}
308
9c27968f 309sub as { @_ }
310sub from { @_ }
76d37e5a 311sub where (&) { $_[0] }
312sub via (&) { $_[0] }
8ecb1fa0 313
314sub message (&) { +{ message => $_[0] } }
315sub optimize_as (&) { +{ optimized => $_[0] } }
a15dff8d 316
9c27968f 317sub enum {
fcec2383 318 my ($type_name, @values) = @_;
4ab662d6 319 # NOTE:
320 # if only an array-ref is passed then
9f4334a1 321 # you get an anon-enum
322 # - SL
323 if (ref $type_name eq 'ARRAY' && !@values) {
324 @values = @$type_name;
325 $type_name = undef;
326 }
2c0cbef7 327 (scalar @values >= 2)
c245d69b 328 || Moose->throw_error("You must have at least two values to enumerate through");
c4fe165f 329 my %valid = map { $_ => 1 } @values;
dabed765 330
331 register_type_constraint(
332 create_enum_type_constraint(
333 $type_name,
334 \@values,
335 )
336 );
337}
338
0c015f1b 339sub create_enum_type_constraint {
dabed765 340 my ( $type_name, $values ) = @_;
e606ae5f 341
dabed765 342 Moose::Meta::TypeConstraint::Enum->new(
343 name => $type_name || '__ANON__',
344 values => $values,
a0f8153d 345 );
fcec2383 346}
347
d9b40005 348## --------------------------------------------------------
349## desugaring functions ...
350## --------------------------------------------------------
351
e85d2a5d 352sub _create_type_constraint ($$$;$$) {
d9b40005 353 my $name = shift;
354 my $parent = shift;
8de73ff1 355 my $check = shift;
e85d2a5d 356
1da6728b 357 my ( $message, $optimized );
d9b40005 358 for (@_) {
359 $message = $_->{message} if exists $_->{message};
e85d2a5d 360 $optimized = $_->{optimized} if exists $_->{optimized};
d9b40005 361 }
362
1da6728b 363 my $pkg_defined_in = scalar( caller(0) );
e85d2a5d 364
1da6728b 365 if ( defined $name ) {
d9b40005 366 my $type = $REGISTRY->get_type_constraint($name);
e85d2a5d 367
5f223879 368 ( $type->_package_defined_in eq $pkg_defined_in )
369 || _confess(
370 "The type constraint '$name' has already been created in "
371 . $type->_package_defined_in
372 . " and cannot be created again in "
373 . $pkg_defined_in )
374 if defined $type;
e85d2a5d 375 }
1da6728b 376
9ceb576e 377 my %opts = (
ec8b7b21 378 name => $name,
d9b40005 379 package_defined_in => $pkg_defined_in,
e85d2a5d 380
1da6728b 381 ( $check ? ( constraint => $check ) : () ),
382 ( $message ? ( message => $message ) : () ),
383 ( $optimized ? ( optimized => $optimized ) : () ),
d9b40005 384 );
1da6728b 385
9ceb576e 386 my $constraint;
1da6728b 387 if ( defined $parent
388 and $parent
389 = blessed $parent ? $parent : find_or_parse_type_constraint($parent) )
390 {
85a9908f 391 $constraint = $parent->create_child_type(%opts);
1da6728b 392 }
393 else {
394 $constraint = Moose::Meta::TypeConstraint->new(%opts);
4ab662d6 395 }
d9b40005 396
397 $REGISTRY->add_type_constraint($constraint)
398 if defined $name;
399
400 return $constraint;
401}
402
e85d2a5d 403sub _install_type_coercions ($$) {
d9b40005 404 my ($type_name, $coercion_map) = @_;
e606ae5f 405 my $type = find_type_constraint($type_name);
6f9ff1af 406 (defined $type)
c245d69b 407 || Moose->throw_error("Cannot find type '$type_name', perhaps you forgot to load it.");
41e007e4 408 if ($type->has_coercion) {
409 $type->coercion->add_type_coercions(@$coercion_map);
410 }
411 else {
412 my $type_coercion = Moose::Meta::TypeCoercion->new(
413 type_coercion_map => $coercion_map,
414 type_constraint => $type
415 );
416 $type->coercion($type_coercion);
417 }
d9b40005 418}
419
420## --------------------------------------------------------
f1917f58 421## type notation parsing ...
422## --------------------------------------------------------
423
424{
e85d2a5d 425 # All I have to say is mugwump++ cause I know
426 # do not even have enough regexp-fu to be able
427 # to have written this (I can only barely
f1917f58 428 # understand it as it is)
e85d2a5d 429 # - SL
430
f1917f58 431 use re "eval";
432
3796382a 433 my $valid_chars = qr{[\w:]};
f1917f58 434 my $type_atom = qr{ $valid_chars+ };
435
be722745 436 my $any;
437
369a74ee 438 my $type = qr{ $valid_chars+ (?: \[ \s* (??{$any}) \s* \] )? }x;
08380fdb 439 my $type_capture_parts = qr{ ($valid_chars+) (?: \[ \s* ((??{$any})) \s* \] )? }x;
369a74ee 440 my $type_with_parameter = qr{ $valid_chars+ \[ \s* (??{$any}) \s* \] }x;
f1917f58 441
3796382a 442 my $op_union = qr{ \s* \| \s* }x;
f1917f58 443 my $union = qr{ $type (?: $op_union $type )+ }x;
444
84a9c64c 445 $any = qr{ $type | $union }x;
f1917f58 446
0fbd4b0a 447 sub _parse_parameterized_type_constraint {
be722745 448 { no warnings 'void'; $any; } # force capture of interpolated lexical
84a9c64c 449 $_[0] =~ m{ $type_capture_parts }x;
450 return ($1, $2);
f1917f58 451 }
452
0fbd4b0a 453 sub _detect_parameterized_type_constraint {
be722745 454 { no warnings 'void'; $any; } # force capture of interpolated lexical
e85d2a5d 455 $_[0] =~ m{ ^ $type_with_parameter $ }x;
f1917f58 456 }
457
458 sub _parse_type_constraint_union {
be722745 459 { no warnings 'void'; $any; } # force capture of interpolated lexical
e85d2a5d 460 my $given = shift;
461 my @rv;
462 while ( $given =~ m{ \G (?: $op_union )? ($type) }gcx ) {
82a5b1a7 463 push @rv => $1;
e85d2a5d 464 }
465 (pos($given) eq length($given))
c245d69b 466 || Moose->throw_error("'$given' didn't parse (parse-pos="
e85d2a5d 467 . pos($given)
468 . " and str-length="
469 . length($given)
4c0b3599 470 . ")");
e85d2a5d 471 @rv;
f1917f58 472 }
473
474 sub _detect_type_constraint_union {
be722745 475 { no warnings 'void'; $any; } # force capture of interpolated lexical
e85d2a5d 476 $_[0] =~ m{^ $type $op_union $type ( $op_union .* )? $}x;
f1917f58 477 }
478}
479
480## --------------------------------------------------------
d9b40005 481# define some basic built-in types
482## --------------------------------------------------------
a15dff8d 483
3cae4250 484# By making these classes immutable before creating all the types we
485# below, we avoid repeatedly calling the slow MOP-based accessors.
486$_->make_immutable(
487 inline_constructor => 1,
488 constructor_name => "_new",
489
490 # these are Class::MOP accessors, so they need inlining
491 inline_accessors => 1
492 ) for grep { $_->is_mutable }
bda8d00f 493 map { Class::MOP::get_meta($_) }
3cae4250 494 qw(
495 Moose::Meta::TypeConstraint
496 Moose::Meta::TypeConstraint::Union
497 Moose::Meta::TypeConstraint::Parameterized
498 Moose::Meta::TypeConstraint::Parameterizable
499 Moose::Meta::TypeConstraint::Class
500 Moose::Meta::TypeConstraint::Role
501 Moose::Meta::TypeConstraint::Enum
502 Moose::Meta::TypeConstraint::Registry
503);
504
f65cb534 505type 'Any' => where { 1 }; # meta-type including all
e85d2a5d 506type 'Item' => where { 1 }; # base-type
a15dff8d 507
fd542f49 508subtype 'Undef' => as 'Item' => where { !defined($_) };
509subtype 'Defined' => as 'Item' => where { defined($_) };
a15dff8d 510
8ecb1fa0 511subtype 'Bool'
e85d2a5d 512 => as 'Item'
8ecb1fa0 513 => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
5a4c5493 514
e85d2a5d 515subtype 'Value'
516 => as 'Defined'
517 => where { !ref($_) }
28ffb449 518 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value;
e85d2a5d 519
8ecb1fa0 520subtype 'Ref'
e85d2a5d 521 => as 'Defined'
522 => where { ref($_) }
28ffb449 523 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref;
8ecb1fa0 524
e85d2a5d 525subtype 'Str'
526 => as 'Value'
527 => where { 1 }
28ffb449 528 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
8ecb1fa0 529
e85d2a5d 530subtype 'Num'
531 => as 'Value'
532 => where { Scalar::Util::looks_like_number($_) }
28ffb449 533 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num;
e85d2a5d 534
535subtype 'Int'
536 => as 'Num'
8ecb1fa0 537 => where { "$_" =~ /^-?[0-9]+$/ }
28ffb449 538 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int;
8ecb1fa0 539
28ffb449 540subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef;
28ffb449 541subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef;
542subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef;
543subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef;
a15dff8d 544
0a5bd159 545# NOTE:
e85d2a5d 546# scalar filehandles are GLOB refs,
0a5bd159 547# but a GLOB ref is not always a filehandle
e85d2a5d 548subtype 'FileHandle'
549 => as 'GlobRef'
128c601e 550 => where { Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") ) }
28ffb449 551 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle;
0a5bd159 552
e85d2a5d 553# NOTE:
a15dff8d 554# blessed(qr/.../) returns true,.. how odd
e85d2a5d 555subtype 'Object'
556 => as 'Ref'
8ecb1fa0 557 => where { blessed($_) && blessed($_) ne 'Regexp' }
28ffb449 558 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object;
a15dff8d 559
e85d2a5d 560subtype 'Role'
561 => as 'Object'
8ecb1fa0 562 => where { $_->can('does') }
28ffb449 563 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
e85d2a5d 564
0e0709ea 565my $_class_name_checker = sub {
0e0709ea 566};
567
e85d2a5d 568subtype 'ClassName'
569 => as 'Str'
e151db23 570 => where { Class::MOP::is_class_loaded($_) }
571 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
02a0fb52 572
d9b40005 573## --------------------------------------------------------
7e4e1ad4 574# parameterizable types ...
575
576$REGISTRY->add_type_constraint(
577 Moose::Meta::TypeConstraint::Parameterizable->new(
578 name => 'ArrayRef',
579 package_defined_in => __PACKAGE__,
580 parent => find_type_constraint('Ref'),
581 constraint => sub { ref($_) eq 'ARRAY' },
582 optimized => \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef,
583 constraint_generator => sub {
584 my $type_parameter = shift;
dabed765 585 my $check = $type_parameter->_compiled_type_constraint;
7e4e1ad4 586 return sub {
587 foreach my $x (@$_) {
dabed765 588 ($check->($x)) || return
7e4e1ad4 589 } 1;
590 }
591 }
592 )
593);
594
595$REGISTRY->add_type_constraint(
596 Moose::Meta::TypeConstraint::Parameterizable->new(
597 name => 'HashRef',
598 package_defined_in => __PACKAGE__,
599 parent => find_type_constraint('Ref'),
600 constraint => sub { ref($_) eq 'HASH' },
601 optimized => \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef,
602 constraint_generator => sub {
4ab662d6 603 my $type_parameter = shift;
dabed765 604 my $check = $type_parameter->_compiled_type_constraint;
7e4e1ad4 605 return sub {
606 foreach my $x (values %$_) {
dabed765 607 ($check->($x)) || return
7e4e1ad4 608 } 1;
609 }
610 }
611 )
612);
613
614$REGISTRY->add_type_constraint(
615 Moose::Meta::TypeConstraint::Parameterizable->new(
616 name => 'Maybe',
617 package_defined_in => __PACKAGE__,
618 parent => find_type_constraint('Item'),
619 constraint => sub { 1 },
620 constraint_generator => sub {
4ab662d6 621 my $type_parameter = shift;
dabed765 622 my $check = $type_parameter->_compiled_type_constraint;
7e4e1ad4 623 return sub {
dabed765 624 return 1 if not(defined($_)) || $check->($_);
7e4e1ad4 625 return;
626 }
627 }
628 )
629);
630
4ab662d6 631my @PARAMETERIZABLE_TYPES = map {
632 $REGISTRY->get_type_constraint($_)
7e4e1ad4 633} qw[ArrayRef HashRef Maybe];
634
635sub get_all_parameterizable_types { @PARAMETERIZABLE_TYPES }
4ab662d6 636sub add_parameterizable_type {
7e4e1ad4 637 my $type = shift;
638 (blessed $type && $type->isa('Moose::Meta::TypeConstraint::Parameterizable'))
c245d69b 639 || Moose->throw_error("Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type");
7e4e1ad4 640 push @PARAMETERIZABLE_TYPES => $type;
4ab662d6 641}
7e4e1ad4 642
643## --------------------------------------------------------
d9b40005 644# end of built-in types ...
645## --------------------------------------------------------
646
943596a6 647{
648 my @BUILTINS = list_all_type_constraints();
649 sub list_all_builtin_type_constraints { @BUILTINS }
650}
651
a15dff8d 6521;
653
654__END__
655
656=pod
657
658=head1 NAME
659
e522431d 660Moose::Util::TypeConstraints - Type constraint system for Moose
a15dff8d 661
662=head1 SYNOPSIS
663
664 use Moose::Util::TypeConstraints;
665
2c0cbef7 666 type 'Num' => where { Scalar::Util::looks_like_number($_) };
e85d2a5d 667
668 subtype 'Natural'
e606ae5f 669 => as 'Int'
a15dff8d 670 => where { $_ > 0 };
e85d2a5d 671
672 subtype 'NaturalLessThanTen'
2c0cbef7 673 => as 'Natural'
79592a54 674 => where { $_ < 10 }
675 => message { "This number ($_) is not less than ten!" };
e85d2a5d 676
677 coerce 'Num'
2c0cbef7 678 => from 'Str'
e85d2a5d 679 => via { 0+$_ };
680
2c0cbef7 681 enum 'RGBColors' => qw(red green blue);
a15dff8d 682
683=head1 DESCRIPTION
684
e85d2a5d 685This module provides Moose with the ability to create custom type
686contraints to be used in attribute definition.
e522431d 687
6ba6d68c 688=head2 Important Caveat
689
e85d2a5d 690This is B<NOT> a type system for Perl 5. These are type constraints,
691and they are not used by Moose unless you tell it to. No type
692inference is performed, expression are not typed, etc. etc. etc.
6ba6d68c 693
e85d2a5d 694This is simply a means of creating small constraint functions which
e606ae5f 695can be used to simplify your own type-checking code, with the added
004222dc 696side benefit of making your intentions clearer through self-documentation.
6ba6d68c 697
2c0cbef7 698=head2 Slightly Less Important Caveat
699
004222dc 700It is B<always> a good idea to quote your type and subtype names.
701
e85d2a5d 702This is to prevent perl from trying to execute the call as an indirect
2c0cbef7 703object call. This issue only seems to come up when you have a subtype
e85d2a5d 704the same name as a valid class, but when the issue does arise it tends
705to be quite annoying to debug.
2c0cbef7 706
707So for instance, this:
e85d2a5d 708
2c0cbef7 709 subtype DateTime => as Object => where { $_->isa('DateTime') };
710
711will I<Just Work>, while this:
712
713 use DateTime;
714 subtype DateTime => as Object => where { $_->isa('DateTime') };
715
e85d2a5d 716will fail silently and cause many headaches. The simple way to solve
717this, as well as future proof your subtypes from classes which have
2c0cbef7 718yet to have been created yet, is to simply do this:
719
720 use DateTime;
d44714be 721 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
2c0cbef7 722
6ba6d68c 723=head2 Default Type Constraints
e522431d 724
e606ae5f 725This module also provides a simple hierarchy for Perl 5 types, here is
004222dc 726that hierarchy represented visually.
e522431d 727
728 Any
e85d2a5d 729 Item
5a4c5493 730 Bool
7e4e1ad4 731 Maybe[`a]
f65cb534 732 Undef
733 Defined
5a4c5493 734 Value
735 Num
736 Int
737 Str
9af1d28b 738 ClassName
5a4c5493 739 Ref
740 ScalarRef
7e4e1ad4 741 ArrayRef[`a]
742 HashRef[`a]
5a4c5493 743 CodeRef
744 RegexpRef
3f7376b0 745 GlobRef
0a5bd159 746 FileHandle
e85d2a5d 747 Object
5a4c5493 748 Role
e522431d 749
4ab662d6 750B<NOTE:> Any type followed by a type parameter C<[`a]> can be
7e4e1ad4 751parameterized, this means you can say:
752
757e07ef 753 ArrayRef[Int] # an array of integers
7e4e1ad4 754 HashRef[CodeRef] # a hash of str to CODE ref mappings
755 Maybe[Str] # value may be a string, may be undefined
756
e606ae5f 757B<NOTE:> Unless you parameterize a type, then it is invalid to
758include the square brackets. I.e. C<ArrayRef[]> will be
759literally interpreted as a type name.
760
4ab662d6 761B<NOTE:> The C<Undef> type constraint for the most part works
762correctly now, but edge cases may still exist, please use it
7e4e1ad4 763sparringly.
703e92fb 764
7e4e1ad4 765B<NOTE:> The C<ClassName> type constraint does a complex package
4ab662d6 766existence check. This means that your class B<must> be loaded for
767this type constraint to pass. I know this is not ideal for all,
7e4e1ad4 768but it is a saner restriction than most others.
9af1d28b 769
e606ae5f 770=head2 Type Constraint Naming
004222dc 771
e606ae5f 772Since the types created by this module are global, it is suggested
773that you namespace your types just as you would namespace your
004222dc 774modules. So instead of creating a I<Color> type for your B<My::Graphics>
775module, you would call the type I<My::Graphics::Color> instead.
776
703e92fb 777=head2 Use with Other Constraint Modules
778
e85d2a5d 779This module should play fairly nicely with other constraint
780modules with only some slight tweaking. The C<where> clause
703e92fb 781in types is expected to be a C<CODE> reference which checks
004222dc 782it's first argument and returns a boolean. Since most constraint
e85d2a5d 783modules work in a similar way, it should be simple to adapt
703e92fb 784them to work with Moose.
785
e85d2a5d 786For instance, this is how you could use it with
787L<Declare::Constraints::Simple> to declare a completely new type.
703e92fb 788
e85d2a5d 789 type 'HashOfArrayOfObjects'
703e92fb 790 => IsHashRef(
791 -keys => HasLength,
792 -values => IsArrayRef( IsObject ));
793
e606ae5f 794For more examples see the F<t/200_examples/204_example_w_DCS.t>
004222dc 795test file.
703e92fb 796
e85d2a5d 797Here is an example of using L<Test::Deep> and it's non-test
798related C<eq_deeply> function.
703e92fb 799
e85d2a5d 800 type 'ArrayOfHashOfBarsAndRandomNumbers'
703e92fb 801 => where {
e85d2a5d 802 eq_deeply($_,
703e92fb 803 array_each(subhashof({
804 bar => isa('Bar'),
805 random_number => ignore()
e85d2a5d 806 })))
703e92fb 807 };
808
e606ae5f 809For a complete example see the
004222dc 810F<t/200_examples/205_example_w_TestDeep.t> test file.
e85d2a5d 811
a15dff8d 812=head1 FUNCTIONS
813
814=head2 Type Constraint Constructors
815
e85d2a5d 816The following functions are used to create type constraints.
817They will then register the type constraints in a global store
818where Moose can get to them if it needs to.
a15dff8d 819
25f2c3fc 820See the L<SYNOPSIS> for an example of how to use these.
a15dff8d 821
6ba6d68c 822=over 4
a15dff8d 823
6ba6d68c 824=item B<type ($name, $where_clause)>
a15dff8d 825
e85d2a5d 826This creates a base type, which has no parent.
a15dff8d 827
79592a54 828=item B<subtype ($name, $parent, $where_clause, ?$message)>
182134e8 829
e85d2a5d 830This creates a named subtype.
d6e2d9a1 831
79592a54 832=item B<subtype ($parent, $where_clause, ?$message)>
182134e8 833
e85d2a5d 834This creates an unnamed subtype and will return the type
835constraint meta-object, which will be an instance of
836L<Moose::Meta::TypeConstraint>.
a15dff8d 837
620db045 838=item B<class_type ($class, ?$options)>
3fef8ce8 839
840Creates a type constraint with the name C<$class> and the metaclass
841L<Moose::Meta::TypeConstraint::Class>.
842
620db045 843=item B<role_type ($role, ?$options)>
844
845Creates a type constraint with the name C<$role> and the metaclass
846L<Moose::Meta::TypeConstraint::Role>.
847
fcec2383 848=item B<enum ($name, @values)>
849
e85d2a5d 850This will create a basic subtype for a given set of strings.
851The resulting constraint will be a subtype of C<Str> and
4ce56d04 852will match any of the items in C<@values>. It is case sensitive.
853See the L<SYNOPSIS> for a simple example.
2c0cbef7 854
e85d2a5d 855B<NOTE:> This is not a true proper enum type, it is simple
2c0cbef7 856a convient constraint builder.
857
9f4334a1 858=item B<enum (\@values)>
859
4ab662d6 860If passed an ARRAY reference instead of the C<$name>, C<@values> pair,
9f4334a1 861this will create an unnamed enum. This can then be used in an attribute
862definition like so:
863
864 has 'sort_order' => (
865 is => 'ro',
4ab662d6 866 isa => enum([qw[ ascending descending ]]),
9f4334a1 867 );
868
6ba6d68c 869=item B<as>
a15dff8d 870
6ba6d68c 871This is just sugar for the type constraint construction syntax.
a15dff8d 872
6ba6d68c 873=item B<where>
a15dff8d 874
6ba6d68c 875This is just sugar for the type constraint construction syntax.
76d37e5a 876
e606ae5f 877Takes a block/code ref as an argument. When the type constraint is
878tested, the supplied code is run with the value to be tested in
879$_. This block should return true or false to indicate whether or not
880the constraint check passed.
881
76d37e5a 882=item B<message>
883
884This is just sugar for the type constraint construction syntax.
a15dff8d 885
e606ae5f 886Takes a block/code ref as an argument. When the type constraint fails,
887then the code block is run (with the value provided in $_). This code
888ref should return a string, which will be used in the text of the
889exception thrown.
890
8ecb1fa0 891=item B<optimize_as>
892
e85d2a5d 893This can be used to define a "hand optimized" version of your
d44714be 894type constraint which can be used to avoid traversing a subtype
e85d2a5d 895constraint heirarchy.
d44714be 896
e85d2a5d 897B<NOTE:> You should only use this if you know what you are doing,
898all the built in types use this, so your subtypes (assuming they
d44714be 899are shallow) will not likely need to use this.
900
6ba6d68c 901=back
a15dff8d 902
6ba6d68c 903=head2 Type Coercion Constructors
a15dff8d 904
e85d2a5d 905Type constraints can also contain type coercions as well. If you
906ask your accessor to coerce, then Moose will run the type-coercion
907code first, followed by the type constraint check. This feature
908should be used carefully as it is very powerful and could easily
587ae0d2 909take off a limb if you are not careful.
a15dff8d 910
25f2c3fc 911See the L<SYNOPSIS> for an example of how to use these.
a15dff8d 912
6ba6d68c 913=over 4
a15dff8d 914
6ba6d68c 915=item B<coerce>
a15dff8d 916
6ba6d68c 917=item B<from>
a15dff8d 918
6ba6d68c 919This is just sugar for the type coercion construction syntax.
920
921=item B<via>
a15dff8d 922
6ba6d68c 923This is just sugar for the type coercion construction syntax.
a15dff8d 924
925=back
926
004222dc 927=head2 Type Constraint Construction & Locating
928
929=over 4
930
eb4c4e82 931=item B<normalize_type_constraint_name ($type_constraint_name)>
932
933Given a string that is expected to match a type constraint, will normalize the
934string so that extra whitespace and newlines are removed.
935
004222dc 936=item B<create_type_constraint_union ($pipe_seperated_types | @type_constraint_names)>
937
938Given string with C<$pipe_seperated_types> or a list of C<@type_constraint_names>,
939this will return a L<Moose::Meta::TypeConstraint::Union> instance.
940
941=item B<create_parameterized_type_constraint ($type_name)>
942
943Given a C<$type_name> in the form of:
944
945 BaseType[ContainerType]
946
947this will extract the base type and container type and build an instance of
948L<Moose::Meta::TypeConstraint::Parameterized> for it.
949
620db045 950=item B<create_class_type_constraint ($class, ?$options)>
004222dc 951
952Given a class name it will create a new L<Moose::Meta::TypeConstraint::Class>
953object for that class name.
954
620db045 955=item B<create_role_type_constraint ($role, ?$options)>
956
957Given a role name it will create a new L<Moose::Meta::TypeConstraint::Role>
958object for that role name.
959
dabed765 960=item B<create_enum_type_constraint ($name, $values)>
961
620db045 962=item B<find_or_parse_type_constraint ($type_name)>
004222dc 963
964This will attempt to find or create a type constraint given the a C<$type_name>.
965If it cannot find it in the registry, it will see if it should be a union or
620db045 966container type an create one if appropriate
967
968=item B<find_or_create_type_constraint ($type_name, ?$options_for_anon_type)>
969
970This function will first call C<find_or_parse_type_constraint> with the type name.
971
972If no type is found or created, but C<$options_for_anon_type> are provided, it
973will create the corresponding type.
974
975This was used by the C<does> and C<isa> parameters to L<Moose::Meta::Attribute>
976and are now superseded by C<find_or_create_isa_type_constraint> and
977C<find_or_create_does_type_constraint>.
978
979=item B<find_or_create_isa_type_constraint ($type_name)>
980
981=item B<find_or_create_does_type_constraint ($type_name)>
982
ae55929d 983Attempts to parse the type name using C<find_or_parse_type_constraint> and if
620db045 984no appropriate constraint is found will create a new anonymous one.
985
986The C<isa> variant will use C<create_class_type_constraint> and the C<does>
987variant will use C<create_role_type_constraint>.
004222dc 988
989=item B<find_type_constraint ($type_name)>
990
991This function can be used to locate a specific type constraint
992meta-object, of the class L<Moose::Meta::TypeConstraint> or a
993derivative. What you do with it from there is up to you :)
994
995=item B<register_type_constraint ($type_object)>
996
997This function will register a named type constraint with the type registry.
998
999=item B<get_type_constraint_registry>
1000
1001Fetch the L<Moose::Meta::TypeConstraint::Registry> object which
1002keeps track of all type constraints.
1003
1004=item B<list_all_type_constraints>
1005
1006This will return a list of type constraint names, you can then
1007fetch them using C<find_type_constraint ($type_name)> if you
1008want to.
1009
1010=item B<list_all_builtin_type_constraints>
1011
1012This will return a list of builtin type constraints, meaning,
1013those which are defined in this module. See the section
1014labeled L<Default Type Constraints> for a complete list.
1015
1016=item B<export_type_constraints_as_functions>
1017
1018This will export all the current type constraints as functions
1019into the caller's namespace. Right now, this is mostly used for
1020testing, but it might prove useful to others.
1021
1022=item B<get_all_parameterizable_types>
1023
1024This returns all the parameterizable types that have been registered.
1025
1026=item B<add_parameterizable_type ($type)>
1027
1028Adds C<$type> to the list of parameterizable types
1029
1030=back
1031
571dd39f 1032=head2 Namespace Management
1033
1034=over 4
1035
1036=item B<unimport>
1037
e85d2a5d 1038This will remove all the type constraint keywords from the
571dd39f 1039calling class namespace.
1040
1041=back
1042
a15dff8d 1043=head1 BUGS
1044
e85d2a5d 1045All complex software has bugs lurking in it, and this module is no
a15dff8d 1046exception. If you find a bug please either email me, or add the bug
1047to cpan-RT.
1048
a15dff8d 1049=head1 AUTHOR
1050
1051Stevan Little E<lt>stevan@iinteractive.comE<gt>
1052
1053=head1 COPYRIGHT AND LICENSE
1054
778db3ac 1055Copyright 2006-2008 by Infinity Interactive, Inc.
a15dff8d 1056
1057L<http://www.iinteractive.com>
1058
1059This library is free software; you can redistribute it and/or modify
e85d2a5d 1060it under the same terms as Perl itself.
a15dff8d 1061
81dc201f 1062=cut