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