Use the new method->execute API for BUILDALL and DEMOLISHALL
[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
aead17e7 12our $VERSION = '0.62';
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
f65cb534 484type 'Any' => where { 1 }; # meta-type including all
e85d2a5d 485type 'Item' => where { 1 }; # base-type
a15dff8d 486
fd542f49 487subtype 'Undef' => as 'Item' => where { !defined($_) };
488subtype 'Defined' => as 'Item' => where { defined($_) };
a15dff8d 489
8ecb1fa0 490subtype 'Bool'
e85d2a5d 491 => as 'Item'
8ecb1fa0 492 => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
5a4c5493 493
e85d2a5d 494subtype 'Value'
495 => as 'Defined'
496 => where { !ref($_) }
28ffb449 497 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value;
e85d2a5d 498
8ecb1fa0 499subtype 'Ref'
e85d2a5d 500 => as 'Defined'
501 => where { ref($_) }
28ffb449 502 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref;
8ecb1fa0 503
e85d2a5d 504subtype 'Str'
505 => as 'Value'
506 => where { 1 }
28ffb449 507 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
8ecb1fa0 508
e85d2a5d 509subtype 'Num'
510 => as 'Value'
511 => where { Scalar::Util::looks_like_number($_) }
28ffb449 512 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num;
e85d2a5d 513
514subtype 'Int'
515 => as 'Num'
8ecb1fa0 516 => where { "$_" =~ /^-?[0-9]+$/ }
28ffb449 517 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int;
8ecb1fa0 518
28ffb449 519subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef;
28ffb449 520subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef;
521subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef;
522subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef;
a15dff8d 523
0a5bd159 524# NOTE:
e85d2a5d 525# scalar filehandles are GLOB refs,
0a5bd159 526# but a GLOB ref is not always a filehandle
e85d2a5d 527subtype 'FileHandle'
528 => as 'GlobRef'
128c601e 529 => where { Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") ) }
28ffb449 530 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle;
0a5bd159 531
e85d2a5d 532# NOTE:
a15dff8d 533# blessed(qr/.../) returns true,.. how odd
e85d2a5d 534subtype 'Object'
535 => as 'Ref'
8ecb1fa0 536 => where { blessed($_) && blessed($_) ne 'Regexp' }
28ffb449 537 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object;
a15dff8d 538
e85d2a5d 539subtype 'Role'
540 => as 'Object'
8ecb1fa0 541 => where { $_->can('does') }
28ffb449 542 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
e85d2a5d 543
0e0709ea 544my $_class_name_checker = sub {
0e0709ea 545};
546
e85d2a5d 547subtype 'ClassName'
548 => as 'Str'
e151db23 549 => where { Class::MOP::is_class_loaded($_) }
550 => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
02a0fb52 551
d9b40005 552## --------------------------------------------------------
7e4e1ad4 553# parameterizable types ...
554
555$REGISTRY->add_type_constraint(
556 Moose::Meta::TypeConstraint::Parameterizable->new(
557 name => 'ArrayRef',
558 package_defined_in => __PACKAGE__,
559 parent => find_type_constraint('Ref'),
560 constraint => sub { ref($_) eq 'ARRAY' },
561 optimized => \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef,
562 constraint_generator => sub {
563 my $type_parameter = shift;
dabed765 564 my $check = $type_parameter->_compiled_type_constraint;
7e4e1ad4 565 return sub {
566 foreach my $x (@$_) {
dabed765 567 ($check->($x)) || return
7e4e1ad4 568 } 1;
569 }
570 }
571 )
572);
573
574$REGISTRY->add_type_constraint(
575 Moose::Meta::TypeConstraint::Parameterizable->new(
576 name => 'HashRef',
577 package_defined_in => __PACKAGE__,
578 parent => find_type_constraint('Ref'),
579 constraint => sub { ref($_) eq 'HASH' },
580 optimized => \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef,
581 constraint_generator => sub {
4ab662d6 582 my $type_parameter = shift;
dabed765 583 my $check = $type_parameter->_compiled_type_constraint;
7e4e1ad4 584 return sub {
585 foreach my $x (values %$_) {
dabed765 586 ($check->($x)) || return
7e4e1ad4 587 } 1;
588 }
589 }
590 )
591);
592
593$REGISTRY->add_type_constraint(
594 Moose::Meta::TypeConstraint::Parameterizable->new(
595 name => 'Maybe',
596 package_defined_in => __PACKAGE__,
597 parent => find_type_constraint('Item'),
598 constraint => sub { 1 },
599 constraint_generator => sub {
4ab662d6 600 my $type_parameter = shift;
dabed765 601 my $check = $type_parameter->_compiled_type_constraint;
7e4e1ad4 602 return sub {
dabed765 603 return 1 if not(defined($_)) || $check->($_);
7e4e1ad4 604 return;
605 }
606 }
607 )
608);
609
4ab662d6 610my @PARAMETERIZABLE_TYPES = map {
611 $REGISTRY->get_type_constraint($_)
7e4e1ad4 612} qw[ArrayRef HashRef Maybe];
613
614sub get_all_parameterizable_types { @PARAMETERIZABLE_TYPES }
4ab662d6 615sub add_parameterizable_type {
7e4e1ad4 616 my $type = shift;
617 (blessed $type && $type->isa('Moose::Meta::TypeConstraint::Parameterizable'))
c245d69b 618 || Moose->throw_error("Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type");
7e4e1ad4 619 push @PARAMETERIZABLE_TYPES => $type;
4ab662d6 620}
7e4e1ad4 621
622## --------------------------------------------------------
d9b40005 623# end of built-in types ...
624## --------------------------------------------------------
625
943596a6 626{
627 my @BUILTINS = list_all_type_constraints();
628 sub list_all_builtin_type_constraints { @BUILTINS }
629}
630
a15dff8d 6311;
632
633__END__
634
635=pod
636
637=head1 NAME
638
e522431d 639Moose::Util::TypeConstraints - Type constraint system for Moose
a15dff8d 640
641=head1 SYNOPSIS
642
643 use Moose::Util::TypeConstraints;
644
2c0cbef7 645 type 'Num' => where { Scalar::Util::looks_like_number($_) };
e85d2a5d 646
647 subtype 'Natural'
e606ae5f 648 => as 'Int'
a15dff8d 649 => where { $_ > 0 };
e85d2a5d 650
651 subtype 'NaturalLessThanTen'
2c0cbef7 652 => as 'Natural'
79592a54 653 => where { $_ < 10 }
654 => message { "This number ($_) is not less than ten!" };
e85d2a5d 655
656 coerce 'Num'
2c0cbef7 657 => from 'Str'
e85d2a5d 658 => via { 0+$_ };
659
2c0cbef7 660 enum 'RGBColors' => qw(red green blue);
a15dff8d 661
662=head1 DESCRIPTION
663
e85d2a5d 664This module provides Moose with the ability to create custom type
665contraints to be used in attribute definition.
e522431d 666
6ba6d68c 667=head2 Important Caveat
668
e85d2a5d 669This is B<NOT> a type system for Perl 5. These are type constraints,
670and they are not used by Moose unless you tell it to. No type
671inference is performed, expression are not typed, etc. etc. etc.
6ba6d68c 672
e85d2a5d 673This is simply a means of creating small constraint functions which
e606ae5f 674can be used to simplify your own type-checking code, with the added
004222dc 675side benefit of making your intentions clearer through self-documentation.
6ba6d68c 676
2c0cbef7 677=head2 Slightly Less Important Caveat
678
004222dc 679It is B<always> a good idea to quote your type and subtype names.
680
e85d2a5d 681This is to prevent perl from trying to execute the call as an indirect
2c0cbef7 682object call. This issue only seems to come up when you have a subtype
e85d2a5d 683the same name as a valid class, but when the issue does arise it tends
684to be quite annoying to debug.
2c0cbef7 685
686So for instance, this:
e85d2a5d 687
2c0cbef7 688 subtype DateTime => as Object => where { $_->isa('DateTime') };
689
690will I<Just Work>, while this:
691
692 use DateTime;
693 subtype DateTime => as Object => where { $_->isa('DateTime') };
694
e85d2a5d 695will fail silently and cause many headaches. The simple way to solve
696this, as well as future proof your subtypes from classes which have
2c0cbef7 697yet to have been created yet, is to simply do this:
698
699 use DateTime;
d44714be 700 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
2c0cbef7 701
6ba6d68c 702=head2 Default Type Constraints
e522431d 703
e606ae5f 704This module also provides a simple hierarchy for Perl 5 types, here is
004222dc 705that hierarchy represented visually.
e522431d 706
707 Any
e85d2a5d 708 Item
5a4c5493 709 Bool
7e4e1ad4 710 Maybe[`a]
f65cb534 711 Undef
712 Defined
5a4c5493 713 Value
714 Num
715 Int
716 Str
9af1d28b 717 ClassName
5a4c5493 718 Ref
719 ScalarRef
7e4e1ad4 720 ArrayRef[`a]
721 HashRef[`a]
5a4c5493 722 CodeRef
723 RegexpRef
3f7376b0 724 GlobRef
0a5bd159 725 FileHandle
e85d2a5d 726 Object
5a4c5493 727 Role
e522431d 728
4ab662d6 729B<NOTE:> Any type followed by a type parameter C<[`a]> can be
7e4e1ad4 730parameterized, this means you can say:
731
757e07ef 732 ArrayRef[Int] # an array of integers
7e4e1ad4 733 HashRef[CodeRef] # a hash of str to CODE ref mappings
734 Maybe[Str] # value may be a string, may be undefined
735
e606ae5f 736B<NOTE:> Unless you parameterize a type, then it is invalid to
737include the square brackets. I.e. C<ArrayRef[]> will be
738literally interpreted as a type name.
739
4ab662d6 740B<NOTE:> The C<Undef> type constraint for the most part works
741correctly now, but edge cases may still exist, please use it
7e4e1ad4 742sparringly.
703e92fb 743
7e4e1ad4 744B<NOTE:> The C<ClassName> type constraint does a complex package
4ab662d6 745existence check. This means that your class B<must> be loaded for
746this type constraint to pass. I know this is not ideal for all,
7e4e1ad4 747but it is a saner restriction than most others.
9af1d28b 748
e606ae5f 749=head2 Type Constraint Naming
004222dc 750
e606ae5f 751Since the types created by this module are global, it is suggested
752that you namespace your types just as you would namespace your
004222dc 753modules. So instead of creating a I<Color> type for your B<My::Graphics>
754module, you would call the type I<My::Graphics::Color> instead.
755
703e92fb 756=head2 Use with Other Constraint Modules
757
e85d2a5d 758This module should play fairly nicely with other constraint
759modules with only some slight tweaking. The C<where> clause
703e92fb 760in types is expected to be a C<CODE> reference which checks
004222dc 761it's first argument and returns a boolean. Since most constraint
e85d2a5d 762modules work in a similar way, it should be simple to adapt
703e92fb 763them to work with Moose.
764
e85d2a5d 765For instance, this is how you could use it with
766L<Declare::Constraints::Simple> to declare a completely new type.
703e92fb 767
e85d2a5d 768 type 'HashOfArrayOfObjects'
703e92fb 769 => IsHashRef(
770 -keys => HasLength,
771 -values => IsArrayRef( IsObject ));
772
e606ae5f 773For more examples see the F<t/200_examples/204_example_w_DCS.t>
004222dc 774test file.
703e92fb 775
e85d2a5d 776Here is an example of using L<Test::Deep> and it's non-test
777related C<eq_deeply> function.
703e92fb 778
e85d2a5d 779 type 'ArrayOfHashOfBarsAndRandomNumbers'
703e92fb 780 => where {
e85d2a5d 781 eq_deeply($_,
703e92fb 782 array_each(subhashof({
783 bar => isa('Bar'),
784 random_number => ignore()
e85d2a5d 785 })))
703e92fb 786 };
787
e606ae5f 788For a complete example see the
004222dc 789F<t/200_examples/205_example_w_TestDeep.t> test file.
e85d2a5d 790
a15dff8d 791=head1 FUNCTIONS
792
793=head2 Type Constraint Constructors
794
e85d2a5d 795The following functions are used to create type constraints.
796They will then register the type constraints in a global store
797where Moose can get to them if it needs to.
a15dff8d 798
25f2c3fc 799See the L<SYNOPSIS> for an example of how to use these.
a15dff8d 800
6ba6d68c 801=over 4
a15dff8d 802
6ba6d68c 803=item B<type ($name, $where_clause)>
a15dff8d 804
e85d2a5d 805This creates a base type, which has no parent.
a15dff8d 806
79592a54 807=item B<subtype ($name, $parent, $where_clause, ?$message)>
182134e8 808
e85d2a5d 809This creates a named subtype.
d6e2d9a1 810
79592a54 811=item B<subtype ($parent, $where_clause, ?$message)>
182134e8 812
e85d2a5d 813This creates an unnamed subtype and will return the type
814constraint meta-object, which will be an instance of
815L<Moose::Meta::TypeConstraint>.
a15dff8d 816
620db045 817=item B<class_type ($class, ?$options)>
3fef8ce8 818
819Creates a type constraint with the name C<$class> and the metaclass
820L<Moose::Meta::TypeConstraint::Class>.
821
620db045 822=item B<role_type ($role, ?$options)>
823
824Creates a type constraint with the name C<$role> and the metaclass
825L<Moose::Meta::TypeConstraint::Role>.
826
fcec2383 827=item B<enum ($name, @values)>
828
e85d2a5d 829This will create a basic subtype for a given set of strings.
830The resulting constraint will be a subtype of C<Str> and
4ce56d04 831will match any of the items in C<@values>. It is case sensitive.
832See the L<SYNOPSIS> for a simple example.
2c0cbef7 833
e85d2a5d 834B<NOTE:> This is not a true proper enum type, it is simple
2c0cbef7 835a convient constraint builder.
836
9f4334a1 837=item B<enum (\@values)>
838
4ab662d6 839If passed an ARRAY reference instead of the C<$name>, C<@values> pair,
9f4334a1 840this will create an unnamed enum. This can then be used in an attribute
841definition like so:
842
843 has 'sort_order' => (
844 is => 'ro',
4ab662d6 845 isa => enum([qw[ ascending descending ]]),
9f4334a1 846 );
847
6ba6d68c 848=item B<as>
a15dff8d 849
6ba6d68c 850This is just sugar for the type constraint construction syntax.
a15dff8d 851
6ba6d68c 852=item B<where>
a15dff8d 853
6ba6d68c 854This is just sugar for the type constraint construction syntax.
76d37e5a 855
e606ae5f 856Takes a block/code ref as an argument. When the type constraint is
857tested, the supplied code is run with the value to be tested in
858$_. This block should return true or false to indicate whether or not
859the constraint check passed.
860
76d37e5a 861=item B<message>
862
863This is just sugar for the type constraint construction syntax.
a15dff8d 864
e606ae5f 865Takes a block/code ref as an argument. When the type constraint fails,
866then the code block is run (with the value provided in $_). This code
867ref should return a string, which will be used in the text of the
868exception thrown.
869
8ecb1fa0 870=item B<optimize_as>
871
e85d2a5d 872This can be used to define a "hand optimized" version of your
d44714be 873type constraint which can be used to avoid traversing a subtype
e85d2a5d 874constraint heirarchy.
d44714be 875
e85d2a5d 876B<NOTE:> You should only use this if you know what you are doing,
877all the built in types use this, so your subtypes (assuming they
d44714be 878are shallow) will not likely need to use this.
879
6ba6d68c 880=back
a15dff8d 881
6ba6d68c 882=head2 Type Coercion Constructors
a15dff8d 883
e85d2a5d 884Type constraints can also contain type coercions as well. If you
885ask your accessor to coerce, then Moose will run the type-coercion
886code first, followed by the type constraint check. This feature
887should be used carefully as it is very powerful and could easily
587ae0d2 888take off a limb if you are not careful.
a15dff8d 889
25f2c3fc 890See the L<SYNOPSIS> for an example of how to use these.
a15dff8d 891
6ba6d68c 892=over 4
a15dff8d 893
6ba6d68c 894=item B<coerce>
a15dff8d 895
6ba6d68c 896=item B<from>
a15dff8d 897
6ba6d68c 898This is just sugar for the type coercion construction syntax.
899
900=item B<via>
a15dff8d 901
6ba6d68c 902This is just sugar for the type coercion construction syntax.
a15dff8d 903
904=back
905
004222dc 906=head2 Type Constraint Construction & Locating
907
908=over 4
909
eb4c4e82 910=item B<normalize_type_constraint_name ($type_constraint_name)>
911
912Given a string that is expected to match a type constraint, will normalize the
913string so that extra whitespace and newlines are removed.
914
004222dc 915=item B<create_type_constraint_union ($pipe_seperated_types | @type_constraint_names)>
916
917Given string with C<$pipe_seperated_types> or a list of C<@type_constraint_names>,
918this will return a L<Moose::Meta::TypeConstraint::Union> instance.
919
920=item B<create_parameterized_type_constraint ($type_name)>
921
922Given a C<$type_name> in the form of:
923
924 BaseType[ContainerType]
925
926this will extract the base type and container type and build an instance of
927L<Moose::Meta::TypeConstraint::Parameterized> for it.
928
620db045 929=item B<create_class_type_constraint ($class, ?$options)>
004222dc 930
931Given a class name it will create a new L<Moose::Meta::TypeConstraint::Class>
932object for that class name.
933
620db045 934=item B<create_role_type_constraint ($role, ?$options)>
935
936Given a role name it will create a new L<Moose::Meta::TypeConstraint::Role>
937object for that role name.
938
dabed765 939=item B<create_enum_type_constraint ($name, $values)>
940
620db045 941=item B<find_or_parse_type_constraint ($type_name)>
004222dc 942
943This will attempt to find or create a type constraint given the a C<$type_name>.
944If it cannot find it in the registry, it will see if it should be a union or
620db045 945container type an create one if appropriate
946
947=item B<find_or_create_type_constraint ($type_name, ?$options_for_anon_type)>
948
949This function will first call C<find_or_parse_type_constraint> with the type name.
950
951If no type is found or created, but C<$options_for_anon_type> are provided, it
952will create the corresponding type.
953
954This was used by the C<does> and C<isa> parameters to L<Moose::Meta::Attribute>
955and are now superseded by C<find_or_create_isa_type_constraint> and
956C<find_or_create_does_type_constraint>.
957
958=item B<find_or_create_isa_type_constraint ($type_name)>
959
960=item B<find_or_create_does_type_constraint ($type_name)>
961
ae55929d 962Attempts to parse the type name using C<find_or_parse_type_constraint> and if
620db045 963no appropriate constraint is found will create a new anonymous one.
964
965The C<isa> variant will use C<create_class_type_constraint> and the C<does>
966variant will use C<create_role_type_constraint>.
004222dc 967
968=item B<find_type_constraint ($type_name)>
969
970This function can be used to locate a specific type constraint
971meta-object, of the class L<Moose::Meta::TypeConstraint> or a
972derivative. What you do with it from there is up to you :)
973
974=item B<register_type_constraint ($type_object)>
975
976This function will register a named type constraint with the type registry.
977
978=item B<get_type_constraint_registry>
979
980Fetch the L<Moose::Meta::TypeConstraint::Registry> object which
981keeps track of all type constraints.
982
983=item B<list_all_type_constraints>
984
985This will return a list of type constraint names, you can then
986fetch them using C<find_type_constraint ($type_name)> if you
987want to.
988
989=item B<list_all_builtin_type_constraints>
990
991This will return a list of builtin type constraints, meaning,
992those which are defined in this module. See the section
993labeled L<Default Type Constraints> for a complete list.
994
995=item B<export_type_constraints_as_functions>
996
997This will export all the current type constraints as functions
998into the caller's namespace. Right now, this is mostly used for
999testing, but it might prove useful to others.
1000
1001=item B<get_all_parameterizable_types>
1002
1003This returns all the parameterizable types that have been registered.
1004
1005=item B<add_parameterizable_type ($type)>
1006
1007Adds C<$type> to the list of parameterizable types
1008
1009=back
1010
571dd39f 1011=head2 Namespace Management
1012
1013=over 4
1014
1015=item B<unimport>
1016
e85d2a5d 1017This will remove all the type constraint keywords from the
571dd39f 1018calling class namespace.
1019
1020=back
1021
a15dff8d 1022=head1 BUGS
1023
e85d2a5d 1024All complex software has bugs lurking in it, and this module is no
a15dff8d 1025exception. If you find a bug please either email me, or add the bug
1026to cpan-RT.
1027
a15dff8d 1028=head1 AUTHOR
1029
1030Stevan Little E<lt>stevan@iinteractive.comE<gt>
1031
1032=head1 COPYRIGHT AND LICENSE
1033
778db3ac 1034Copyright 2006-2008 by Infinity Interactive, Inc.
a15dff8d 1035
1036L<http://www.iinteractive.com>
1037
1038This library is free software; you can redistribute it and/or modify
e85d2a5d 1039it under the same terms as Perl itself.
a15dff8d 1040
81dc201f 1041=cut