bump version to 1.09
[gitmo/Moose.git] / lib / Moose / Util / TypeConstraints.pm
CommitLineData
a15dff8d 1
2package Moose::Util::TypeConstraints;
3
998a8a25 4use Carp ();
9e856c83 5use List::MoreUtils qw( all any );
9a63faba 6use Scalar::Util qw( blessed reftype );
e606ae5f 7use Moose::Exporter;
a15dff8d 8
60f08160 9our $VERSION = '1.09';
e606ae5f 10$VERSION = eval $VERSION;
d44714be 11our $AUTHORITY = 'cpan:STEVAN';
a15dff8d 12
d9b40005 13## --------------------------------------------------------
e85d2a5d 14# Prototyped subs must be predeclared because we have a
15# circular dependency with Moose::Meta::Attribute et. al.
16# so in case of us being use'd first the predeclaration
d9b40005 17# ensures the prototypes are in scope when consumers are
18# compiled.
19
d9b40005 20# dah sugah!
180899ed 21sub where (&);
22sub via (&);
23sub message (&);
d9b40005 24sub optimize_as (&);
d9b40005 25
d9b40005 26## --------------------------------------------------------
8c4acc60 27
1fa1a58d 28use Moose::Deprecated;
4e036ee4 29use Moose::Meta::TypeConstraint;
3726f905 30use Moose::Meta::TypeConstraint::Union;
0fbd4b0a 31use Moose::Meta::TypeConstraint::Parameterized;
7e4e1ad4 32use Moose::Meta::TypeConstraint::Parameterizable;
620db045 33use Moose::Meta::TypeConstraint::Class;
34use Moose::Meta::TypeConstraint::Role;
dabed765 35use Moose::Meta::TypeConstraint::Enum;
0a6bff54 36use Moose::Meta::TypeConstraint::DuckType;
2ca63f5d 37use Moose::Meta::TypeCoercion;
3726f905 38use Moose::Meta::TypeCoercion::Union;
22aed3c0 39use Moose::Meta::TypeConstraint::Registry;
28ffb449 40use Moose::Util::TypeConstraints::OptimizedConstraints;
4e036ee4 41
e606ae5f 42Moose::Exporter->setup_import_methods(
43 as_is => [
44 qw(
180899ed 45 type subtype class_type role_type maybe_type duck_type
1b2c9bda 46 as where message optimize_as
e606ae5f 47 coerce from via
48 enum
49 find_type_constraint
0d29b772 50 register_type_constraint
51 match_on_type )
e606ae5f 52 ],
e606ae5f 53);
a15dff8d 54
d9b40005 55## --------------------------------------------------------
56## type registry and some useful functions for it
57## --------------------------------------------------------
58
22aed3c0 59my $REGISTRY = Moose::Meta::TypeConstraint::Registry->new;
587ae0d2 60
180899ed 61sub get_type_constraint_registry {$REGISTRY}
62sub list_all_type_constraints { keys %{ $REGISTRY->type_constraints } }
63
d9b40005 64sub export_type_constraints_as_functions {
65 my $pkg = caller();
66 no strict 'refs';
180899ed 67 foreach my $constraint ( keys %{ $REGISTRY->type_constraints } ) {
68 my $tc = $REGISTRY->get_type_constraint($constraint)
69 ->_compiled_type_constraint;
70 *{"${pkg}::${constraint}"}
71 = sub { $tc->( $_[0] ) ? 1 : undef }; # the undef is for compat
a0f8153d 72 }
d9b40005 73}
182134e8 74
0c015f1b 75sub create_type_constraint_union {
d9b40005 76 my @type_constraint_names;
e85d2a5d 77
180899ed 78 if ( scalar @_ == 1 && _detect_type_constraint_union( $_[0] ) ) {
79 @type_constraint_names = _parse_type_constraint_union( $_[0] );
d9b40005 80 }
81 else {
82 @type_constraint_names = @_;
429ccc11 83 }
180899ed 84
85 ( scalar @type_constraint_names >= 2 )
86 || __PACKAGE__->_throw_error(
87 "You must pass in at least 2 type names to make a union");
e85d2a5d 88
84a9c64c 89 my @type_constraints = map {
180899ed 90 find_or_parse_type_constraint($_)
91 || __PACKAGE__->_throw_error(
92 "Could not locate type constraint ($_) for the union");
08380fdb 93 } @type_constraint_names;
84a9c64c 94
3726f905 95 return Moose::Meta::TypeConstraint::Union->new(
180899ed 96 type_constraints => \@type_constraints );
182134e8 97}
a15dff8d 98
0c015f1b 99sub create_parameterized_type_constraint {
d9b40005 100 my $type_constraint_name = shift;
180899ed 101 my ( $base_type, $type_parameter )
102 = _parse_parameterized_type_constraint($type_constraint_name);
e85d2a5d 103
180899ed 104 ( defined $base_type && defined $type_parameter )
105 || __PACKAGE__->_throw_error(
106 "Could not parse type name ($type_constraint_name) correctly");
e85d2a5d 107
180899ed 108 if ( $REGISTRY->has_type_constraint($base_type) ) {
90e78884 109 my $base_type_tc = $REGISTRY->get_type_constraint($base_type);
110 return _create_parameterized_type_constraint(
111 $base_type_tc,
112 $type_parameter
113 );
180899ed 114 }
115 else {
116 __PACKAGE__->_throw_error(
117 "Could not locate the base type ($base_type)");
90e78884 118 }
22aed3c0 119}
120
90e78884 121sub _create_parameterized_type_constraint {
122 my ( $base_type_tc, $type_parameter ) = @_;
123 if ( $base_type_tc->can('parameterize') ) {
124 return $base_type_tc->parameterize($type_parameter);
180899ed 125 }
126 else {
90e78884 127 return Moose::Meta::TypeConstraint::Parameterized->new(
180899ed 128 name => $base_type_tc->name . '[' . $type_parameter . ']',
90e78884 129 parent => $base_type_tc,
180899ed 130 type_parameter =>
131 find_or_create_isa_type_constraint($type_parameter),
90e78884 132 );
133 }
180899ed 134}
90e78884 135
4ab662d6 136#should we also support optimized checks?
0c015f1b 137sub create_class_type_constraint {
620db045 138 my ( $class, $options ) = @_;
139
180899ed 140# too early for this check
141#find_type_constraint("ClassName")->check($class)
142# || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name");
3fef8ce8 143
620db045 144 my %options = (
145 class => $class,
146 name => $class,
147 %{ $options || {} },
4ab662d6 148 );
620db045 149
150 $options{name} ||= "__ANON__";
151
180899ed 152 Moose::Meta::TypeConstraint::Class->new(%options);
3fef8ce8 153}
154
0c015f1b 155sub create_role_type_constraint {
620db045 156 my ( $role, $options ) = @_;
e85d2a5d 157
180899ed 158# too early for this check
159#find_type_constraint("ClassName")->check($class)
160# || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name");
e85d2a5d 161
620db045 162 my %options = (
163 role => $role,
164 name => $role,
165 %{ $options || {} },
166 );
e85d2a5d 167
620db045 168 $options{name} ||= "__ANON__";
169
180899ed 170 Moose::Meta::TypeConstraint::Role->new(%options);
620db045 171}
172
0c015f1b 173sub find_or_create_type_constraint {
620db045 174 my ( $type_constraint_name, $options_for_anon_type ) = @_;
175
180899ed 176 if ( my $constraint
177 = find_or_parse_type_constraint($type_constraint_name) ) {
620db045 178 return $constraint;
d9b40005 179 }
620db045 180 elsif ( defined $options_for_anon_type ) {
180899ed 181
d9b40005 182 # NOTE:
4ab662d6 183 # if there is no $options_for_anon_type
184 # specified, then we assume they don't
f3c4e20e 185 # want to create one, and return nothing.
f3c4e20e 186
d9b40005 187 # otherwise assume that we should create
e85d2a5d 188 # an ANON type with the $options_for_anon_type
d9b40005 189 # options which can be passed in. It should
e85d2a5d 190 # be noted that these don't get registered
d9b40005 191 # so we need to return it.
192 # - SL
193 return Moose::Meta::TypeConstraint->new(
194 name => '__ANON__',
e85d2a5d 195 %{$options_for_anon_type}
d9b40005 196 );
197 }
e85d2a5d 198
620db045 199 return;
200}
201
0c015f1b 202sub find_or_create_isa_type_constraint {
620db045 203 my $type_constraint_name = shift;
180899ed 204 find_or_parse_type_constraint($type_constraint_name)
205 || create_class_type_constraint($type_constraint_name);
620db045 206}
207
0c015f1b 208sub find_or_create_does_type_constraint {
620db045 209 my $type_constraint_name = shift;
180899ed 210 find_or_parse_type_constraint($type_constraint_name)
211 || create_role_type_constraint($type_constraint_name);
620db045 212}
213
0c015f1b 214sub find_or_parse_type_constraint {
eb4c4e82 215 my $type_constraint_name = normalize_type_constraint_name(shift);
620db045 216 my $constraint;
180899ed 217
218 if ( $constraint = find_type_constraint($type_constraint_name) ) {
e606ae5f 219 return $constraint;
180899ed 220 }
221 elsif ( _detect_type_constraint_union($type_constraint_name) ) {
620db045 222 $constraint = create_type_constraint_union($type_constraint_name);
180899ed 223 }
224 elsif ( _detect_parameterized_type_constraint($type_constraint_name) ) {
225 $constraint
226 = create_parameterized_type_constraint($type_constraint_name);
227 }
228 else {
620db045 229 return;
230 }
bb6c8335 231
d9b40005 232 $REGISTRY->add_type_constraint($constraint);
e85d2a5d 233 return $constraint;
d9b40005 234}
22aed3c0 235
eb4c4e82 236sub normalize_type_constraint_name {
84a9c64c 237 my $type_constraint_name = shift;
c8f663b2 238 $type_constraint_name =~ s/\s//g;
eb4c4e82 239 return $type_constraint_name;
240}
241
5f223879 242sub _confess {
243 my $error = shift;
244
245 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
246 Carp::confess($error);
247}
248
22aed3c0 249## --------------------------------------------------------
250## exported functions ...
251## --------------------------------------------------------
252
0c015f1b 253sub find_type_constraint {
eeedfc8a 254 my $type = shift;
255
256 if ( blessed $type and $type->isa("Moose::Meta::TypeConstraint") ) {
257 return $type;
e606ae5f 258 }
259 else {
260 return unless $REGISTRY->has_type_constraint($type);
eeedfc8a 261 return $REGISTRY->get_type_constraint($type);
262 }
263}
22aed3c0 264
0c015f1b 265sub register_type_constraint {
3fef8ce8 266 my $constraint = shift;
180899ed 267 __PACKAGE__->_throw_error("can't register an unnamed type constraint")
268 unless defined $constraint->name;
3fef8ce8 269 $REGISTRY->add_type_constraint($constraint);
dabed765 270 return $constraint;
3fef8ce8 271}
272
7c13858b 273# type constructors
a15dff8d 274
9c27968f 275sub type {
180899ed 276
9e856c83 277 # back-compat version, called without sugar
180899ed 278 if ( !any { ( reftype($_) || '' ) eq 'HASH' } @_ ) {
44193bda 279 Moose::Deprecated::deprecated(
280 feature => 'type without sugar',
281 message =>
282 'Calling type() with a simple list of parameters is deprecated'
283 );
284
9e856c83 285 return _create_type_constraint( $_[0], undef, $_[1] );
9a63faba 286 }
9a63faba 287
9e856c83 288 my $name = shift;
9a63faba 289
9e856c83 290 my %p = map { %{$_} } @_;
291
180899ed 292 return _create_type_constraint(
293 $name, undef, $p{where}, $p{message},
294 $p{optimize_as}
295 );
a15dff8d 296}
297
9c27968f 298sub subtype {
180899ed 299
9a63faba 300 # crazy back-compat code for being called without sugar ...
e3979c3e 301 #
9a63faba 302 # subtype 'Parent', sub { where };
303 if ( scalar @_ == 2 && ( reftype( $_[1] ) || '' ) eq 'CODE' ) {
44193bda 304 Moose::Deprecated::deprecated(
305 feature => 'subtype without sugar',
306 message =>
307 'Calling subtype() with a simple list of parameters is deprecated'
308 );
309
9a63faba 310 return _create_type_constraint( undef, @_ );
311 }
312
313 # subtype 'Parent', sub { where }, sub { message };
314 # subtype 'Parent', sub { where }, sub { message }, sub { optimized };
315 if ( scalar @_ >= 3 && all { ( reftype($_) || '' ) eq 'CODE' }
180899ed 316 @_[ 1 .. $#_ ] ) {
44193bda 317 Moose::Deprecated::deprecated(
318 feature => 'subtype without sugar',
319 message =>
320 'Calling subtype() with a simple list of parameters is deprecated'
321 );
322
9a63faba 323 return _create_type_constraint( undef, @_ );
324 }
325
326 # subtype 'Name', 'Parent', ...
327 if ( scalar @_ >= 2 && all { !ref } @_[ 0, 1 ] ) {
44193bda 328 Moose::Deprecated::deprecated(
329 feature => 'subtype without sugar',
330 message =>
331 'Calling subtype() with a simple list of parameters is deprecated'
332 );
333
9a63faba 334 return _create_type_constraint(@_);
335 }
336
180899ed 337 if ( @_ == 1 && !ref $_[0] ) {
338 __PACKAGE__->_throw_error(
339 'A subtype cannot consist solely of a name, it must have a parent'
340 );
f75f625d 341 }
342
f6c0c589 343 # The blessed check is mostly to accommodate MooseX::Types, which
344 # uses an object which overloads stringification as a type name.
180899ed 345 my $name = ref $_[0] && !blessed $_[0] ? undef : shift;
9a63faba 346
347 my %p = map { %{$_} } @_;
348
349 # subtype Str => where { ... };
180899ed 350 if ( !exists $p{as} ) {
9e856c83 351 $p{as} = $name;
9a63faba 352 $name = undef;
353 }
354
180899ed 355 return _create_type_constraint(
356 $name, $p{as}, $p{where}, $p{message},
357 $p{optimize_as}
358 );
a15dff8d 359}
360
9c27968f 361sub class_type {
4ab662d6 362 register_type_constraint(
363 create_class_type_constraint(
364 $_[0],
180899ed 365 ( defined( $_[1] ) ? $_[1] : () ),
4ab662d6 366 )
367 );
3fef8ce8 368}
369
620db045 370sub role_type ($;$) {
371 register_type_constraint(
372 create_role_type_constraint(
373 $_[0],
180899ed 374 ( defined( $_[1] ) ? $_[1] : () ),
620db045 375 )
376 );
377}
378
1b2c9bda 379sub maybe_type {
380 my ($type_parameter) = @_;
381
28ce1444 382 register_type_constraint(
ed7060d9 383 $REGISTRY->get_type_constraint('Maybe')->parameterize($type_parameter)
28ce1444 384 );
1b2c9bda 385}
386
180899ed 387sub duck_type {
cdacfaf3 388 my ( $type_name, @methods ) = @_;
180899ed 389 if ( ref $type_name eq 'ARRAY' && !@methods ) {
cdacfaf3 390 @methods = @$type_name;
180899ed 391 $type_name = undef;
392 }
bce5d4a5 393 if ( @methods == 1 && ref $methods[0] eq 'ARRAY' ) {
394 @methods = @{ $methods[0] };
395 }
180899ed 396
397 register_type_constraint(
0a6bff54 398 create_duck_type_constraint(
cdacfaf3 399 $type_name,
0a6bff54 400 \@methods,
180899ed 401 )
402 );
403}
404
9c27968f 405sub coerce {
180899ed 406 my ( $type_name, @coercion_map ) = @_;
407 _install_type_coercions( $type_name, \@coercion_map );
182134e8 408}
409
f6c0c589 410# The trick of returning @_ lets us avoid having to specify a
411# prototype. Perl will parse this:
412#
413# subtype 'Foo'
414# => as 'Str'
415# => where { ... }
416#
417# as this:
418#
419# subtype( 'Foo', as( 'Str', where { ... } ) );
420#
421# If as() returns all it's extra arguments, this just works, and
422# preserves backwards compatibility.
180899ed 423sub as { { as => shift }, @_ }
9e856c83 424sub where (&) { { where => $_[0] } }
425sub message (&) { { message => $_[0] } }
426sub optimize_as (&) { { optimize_as => $_[0] } }
8ecb1fa0 427
9a63faba 428sub from {@_}
429sub via (&) { $_[0] }
a15dff8d 430
9c27968f 431sub enum {
180899ed 432 my ( $type_name, @values ) = @_;
433
4ab662d6 434 # NOTE:
435 # if only an array-ref is passed then
9f4334a1 436 # you get an anon-enum
437 # - SL
180899ed 438 if ( ref $type_name eq 'ARRAY' && !@values ) {
9f4334a1 439 @values = @$type_name;
440 $type_name = undef;
441 }
bce5d4a5 442 if ( @values == 1 && ref $values[0] eq 'ARRAY' ) {
443 @values = @{ $values[0] };
444 }
180899ed 445 ( scalar @values >= 2 )
446 || __PACKAGE__->_throw_error(
447 "You must have at least two values to enumerate through");
c4fe165f 448 my %valid = map { $_ => 1 } @values;
dabed765 449
450 register_type_constraint(
451 create_enum_type_constraint(
452 $type_name,
453 \@values,
454 )
455 );
456}
457
0c015f1b 458sub create_enum_type_constraint {
dabed765 459 my ( $type_name, $values ) = @_;
e606ae5f 460
dabed765 461 Moose::Meta::TypeConstraint::Enum->new(
180899ed 462 name => $type_name || '__ANON__',
dabed765 463 values => $values,
a0f8153d 464 );
fcec2383 465}
466
0a6bff54 467sub create_duck_type_constraint {
468 my ( $type_name, $methods ) = @_;
469
470 Moose::Meta::TypeConstraint::DuckType->new(
471 name => $type_name || '__ANON__',
472 methods => $methods,
473 );
474}
475
0d29b772 476sub match_on_type {
477 my ($to_match, @cases) = @_;
478 my $default;
479 if (@cases % 2 != 0) {
480 $default = pop @cases;
481 (ref $default eq 'CODE')
482 || __PACKAGE__->_throw_error("Default case must be a CODE ref, not $default");
483 }
484 while (@cases) {
485 my ($type, $action) = splice @cases, 0, 2;
486
487 unless (blessed $type && $type->isa('Moose::Meta::TypeConstraint')) {
488 $type = find_or_parse_type_constraint($type)
489 || __PACKAGE__->_throw_error("Cannot find or parse the type '$type'")
490 }
491
492 (ref $action eq 'CODE')
493 || __PACKAGE__->_throw_error("Match action must be a CODE ref, not $action");
494
495 if ($type->check($to_match)) {
496 local $_ = $to_match;
497 return $action->($to_match);
498 }
499 }
1d39d709 500 (defined $default)
501 || __PACKAGE__->_throw_error("No cases matched for $to_match");
0d29b772 502 {
503 local $_ = $to_match;
1d39d709 504 return $default->($to_match);
0d29b772 505 }
506}
507
508
d9b40005 509## --------------------------------------------------------
510## desugaring functions ...
511## --------------------------------------------------------
512
e85d2a5d 513sub _create_type_constraint ($$$;$$) {
9a63faba 514 my $name = shift;
515 my $parent = shift;
516 my $check = shift;
517 my $message = shift;
518 my $optimized = shift;
d9b40005 519
9a63faba 520 my $pkg_defined_in = scalar( caller(1) );
e85d2a5d 521
1da6728b 522 if ( defined $name ) {
d9b40005 523 my $type = $REGISTRY->get_type_constraint($name);
e85d2a5d 524
5f223879 525 ( $type->_package_defined_in eq $pkg_defined_in )
526 || _confess(
527 "The type constraint '$name' has already been created in "
528 . $type->_package_defined_in
529 . " and cannot be created again in "
530 . $pkg_defined_in )
531 if defined $type;
eee1a213 532
533 $name =~ /^[\w:\.]+$/
534 or die qq{$name contains invalid characters for a type name.}
33c8a6d0 535 . qq{ Names can contain alphanumeric character, ":", and "."\n};
e85d2a5d 536 }
1da6728b 537
9ceb576e 538 my %opts = (
9a63faba 539 name => $name,
d9b40005 540 package_defined_in => $pkg_defined_in,
e85d2a5d 541
1da6728b 542 ( $check ? ( constraint => $check ) : () ),
543 ( $message ? ( message => $message ) : () ),
544 ( $optimized ? ( optimized => $optimized ) : () ),
d9b40005 545 );
1da6728b 546
9ceb576e 547 my $constraint;
180899ed 548 if (
549 defined $parent
1da6728b 550 and $parent
180899ed 551 = blessed $parent
552 ? $parent
553 : find_or_create_isa_type_constraint($parent)
554 ) {
85a9908f 555 $constraint = $parent->create_child_type(%opts);
1da6728b 556 }
557 else {
558 $constraint = Moose::Meta::TypeConstraint->new(%opts);
4ab662d6 559 }
d9b40005 560
561 $REGISTRY->add_type_constraint($constraint)
562 if defined $name;
563
564 return $constraint;
565}
566
e85d2a5d 567sub _install_type_coercions ($$) {
180899ed 568 my ( $type_name, $coercion_map ) = @_;
e606ae5f 569 my $type = find_type_constraint($type_name);
180899ed 570 ( defined $type )
571 || __PACKAGE__->_throw_error(
a885c019 572 "Cannot find type '$type_name', perhaps you forgot to load it");
180899ed 573 if ( $type->has_coercion ) {
41e007e4 574 $type->coercion->add_type_coercions(@$coercion_map);
575 }
576 else {
577 my $type_coercion = Moose::Meta::TypeCoercion->new(
578 type_coercion_map => $coercion_map,
579 type_constraint => $type
580 );
581 $type->coercion($type_coercion);
582 }
d9b40005 583}
584
585## --------------------------------------------------------
f1917f58 586## type notation parsing ...
587## --------------------------------------------------------
588
589{
180899ed 590
e85d2a5d 591 # All I have to say is mugwump++ cause I know
592 # do not even have enough regexp-fu to be able
593 # to have written this (I can only barely
f1917f58 594 # understand it as it is)
e85d2a5d 595 # - SL
596
f1917f58 597 use re "eval";
598
eee1a213 599 my $valid_chars = qr{[\w:\.]};
68d5a469 600 my $type_atom = qr{ (?>$valid_chars+) }x;
68113f48 601 my $ws = qr{ (?>\s*) }x;
602 my $op_union = qr{ $ws \| $ws }x;
603
604 my ($type, $type_capture_parts, $type_with_parameter, $union, $any);
605 if (Class::MOP::IS_RUNNING_ON_5_10) {
606 my $type_pattern
607 = q{ (?&type_atom) (?: \[ (?&ws) (?&any) (?&ws) \] )? };
608 my $type_capture_parts_pattern
609 = q{ ((?&type_atom)) (?: \[ (?&ws) ((?&any)) (?&ws) \] )? };
610 my $type_with_parameter_pattern
611 = q{ (?&type_atom) \[ (?&ws) (?&any) (?&ws) \] };
612 my $union_pattern
613 = q{ (?&type) (?> (?: (?&op_union) (?&type) )+ ) };
614 my $any_pattern
615 = q{ (?&type) | (?&union) };
616
617 my $defines = qr{(?(DEFINE)
618 (?<valid_chars> $valid_chars)
619 (?<type_atom> $type_atom)
620 (?<ws> $ws)
621 (?<op_union> $op_union)
622 (?<type> $type_pattern)
623 (?<type_capture_parts> $type_capture_parts_pattern)
624 (?<type_with_parameter> $type_with_parameter_pattern)
625 (?<union> $union_pattern)
626 (?<any> $any_pattern)
627 )}x;
628
629 $type = qr{ $type_pattern $defines }x;
630 $type_capture_parts = qr{ $type_capture_parts_pattern $defines }x;
631 $type_with_parameter = qr{ $type_with_parameter_pattern $defines }x;
632 $union = qr{ $union_pattern $defines }x;
633 $any = qr{ $any_pattern $defines }x;
634 }
635 else {
636 $type
637 = qr{ $type_atom (?: \[ $ws (??{$any}) $ws \] )? }x;
638 $type_capture_parts
639 = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x;
640 $type_with_parameter
641 = qr{ $type_atom \[ $ws (??{$any}) $ws \] }x;
642 $union
643 = qr{ $type (?> (?: $op_union $type )+ ) }x;
644 $any
645 = qr{ $type | $union }x;
646 }
f1917f58 647
f1917f58 648
0fbd4b0a 649 sub _parse_parameterized_type_constraint {
180899ed 650 { no warnings 'void'; $any; } # force capture of interpolated lexical
84a9c64c 651 $_[0] =~ m{ $type_capture_parts }x;
180899ed 652 return ( $1, $2 );
f1917f58 653 }
654
0fbd4b0a 655 sub _detect_parameterized_type_constraint {
180899ed 656 { no warnings 'void'; $any; } # force capture of interpolated lexical
e85d2a5d 657 $_[0] =~ m{ ^ $type_with_parameter $ }x;
f1917f58 658 }
659
660 sub _parse_type_constraint_union {
180899ed 661 { no warnings 'void'; $any; } # force capture of interpolated lexical
e85d2a5d 662 my $given = shift;
663 my @rv;
664 while ( $given =~ m{ \G (?: $op_union )? ($type) }gcx ) {
82a5b1a7 665 push @rv => $1;
e85d2a5d 666 }
180899ed 667 ( pos($given) eq length($given) )
668 || __PACKAGE__->_throw_error( "'$given' didn't parse (parse-pos="
669 . pos($given)
670 . " and str-length="
671 . length($given)
672 . ")" );
e85d2a5d 673 @rv;
f1917f58 674 }
675
676 sub _detect_type_constraint_union {
180899ed 677 { no warnings 'void'; $any; } # force capture of interpolated lexical
e85d2a5d 678 $_[0] =~ m{^ $type $op_union $type ( $op_union .* )? $}x;
f1917f58 679 }
680}
681
682## --------------------------------------------------------
d9b40005 683# define some basic built-in types
684## --------------------------------------------------------
a15dff8d 685
3cae4250 686# By making these classes immutable before creating all the types we
687# below, we avoid repeatedly calling the slow MOP-based accessors.
688$_->make_immutable(
689 inline_constructor => 1,
690 constructor_name => "_new",
691
692 # these are Class::MOP accessors, so they need inlining
693 inline_accessors => 1
694 ) for grep { $_->is_mutable }
37edf27e 695 map { Class::MOP::class_of($_) }
3cae4250 696 qw(
697 Moose::Meta::TypeConstraint
698 Moose::Meta::TypeConstraint::Union
699 Moose::Meta::TypeConstraint::Parameterized
700 Moose::Meta::TypeConstraint::Parameterizable
701 Moose::Meta::TypeConstraint::Class
702 Moose::Meta::TypeConstraint::Role
703 Moose::Meta::TypeConstraint::Enum
0a6bff54 704 Moose::Meta::TypeConstraint::DuckType
3cae4250 705 Moose::Meta::TypeConstraint::Registry
706);
707
180899ed 708type 'Any' => where {1}; # meta-type including all
3054a5c9 709subtype 'Item' => as 'Any'; # base-type
a15dff8d 710
fd542f49 711subtype 'Undef' => as 'Item' => where { !defined($_) };
180899ed 712subtype 'Defined' => as 'Item' => where { defined($_) };
713
714subtype 'Bool' => as 'Item' =>
715 where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
716
717subtype 'Value' => as 'Defined' => where { !ref($_) } =>
718 optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value;
719
720subtype 'Ref' => as 'Defined' => where { ref($_) } =>
721 optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref;
722
9a221523 723subtype 'Str' => as 'Value' => where { ref(\$_) eq 'SCALAR' } =>
180899ed 724 optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
725
c29e3978 726subtype 'Num' => as 'Str' =>
180899ed 727 where { Scalar::Util::looks_like_number($_) } =>
728 optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num;
729
730subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ } =>
731 optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int;
732
180899ed 733subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } =>
734 optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef;
735subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } =>
736 optimize_as
737 \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef;
738subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } =>
739 optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef;
a15dff8d 740
0a5bd159 741# NOTE:
e85d2a5d 742# scalar filehandles are GLOB refs,
0a5bd159 743# but a GLOB ref is not always a filehandle
180899ed 744subtype 'FileHandle' => as 'GlobRef' => where {
745 Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") );
746} => optimize_as
747 \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle;
0a5bd159 748
e85d2a5d 749# NOTE:
a15dff8d 750# blessed(qr/.../) returns true,.. how odd
180899ed 751subtype 'Object' => as 'Ref' =>
752 where { blessed($_) && blessed($_) ne 'Regexp' } =>
753 optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object;
a15dff8d 754
4831e2de 755# This type is deprecated.
180899ed 756subtype 'Role' => as 'Object' => where { $_->can('does') } =>
757 optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
e85d2a5d 758
180899ed 759my $_class_name_checker = sub { };
0e0709ea 760
180899ed 761subtype 'ClassName' => as 'Str' =>
762 where { Class::MOP::is_class_loaded($_) } => optimize_as
763 \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
02a0fb52 764
180899ed 765subtype 'RoleName' => as 'ClassName' => where {
6b885dfa 766 (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
180899ed 767} => optimize_as
768 \&Moose::Util::TypeConstraints::OptimizedConstraints::RoleName;
f0cac16f 769
d9b40005 770## --------------------------------------------------------
7e4e1ad4 771# parameterizable types ...
772
773$REGISTRY->add_type_constraint(
774 Moose::Meta::TypeConstraint::Parameterizable->new(
2c29c0e7 775 name => 'ScalarRef',
776 package_defined_in => __PACKAGE__,
777 parent => find_type_constraint('Ref'),
150e5142 778 constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' },
2c29c0e7 779 optimized =>
780 \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef,
781 constraint_generator => sub {
782 my $type_parameter = shift;
783 my $check = $type_parameter->_compiled_type_constraint;
784 return sub {
785 return $check->(${ $_ });
786 };
787 }
788 )
789);
790
791$REGISTRY->add_type_constraint(
792 Moose::Meta::TypeConstraint::Parameterizable->new(
180899ed 793 name => 'ArrayRef',
794 package_defined_in => __PACKAGE__,
795 parent => find_type_constraint('Ref'),
796 constraint => sub { ref($_) eq 'ARRAY' },
797 optimized =>
798 \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef,
7e4e1ad4 799 constraint_generator => sub {
800 my $type_parameter = shift;
180899ed 801 my $check = $type_parameter->_compiled_type_constraint;
7e4e1ad4 802 return sub {
803 foreach my $x (@$_) {
180899ed 804 ( $check->($x) ) || return;
805 }
806 1;
807 }
7e4e1ad4 808 }
809 )
810);
811
812$REGISTRY->add_type_constraint(
813 Moose::Meta::TypeConstraint::Parameterizable->new(
180899ed 814 name => 'HashRef',
815 package_defined_in => __PACKAGE__,
816 parent => find_type_constraint('Ref'),
817 constraint => sub { ref($_) eq 'HASH' },
818 optimized =>
819 \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef,
7e4e1ad4 820 constraint_generator => sub {
4ab662d6 821 my $type_parameter = shift;
180899ed 822 my $check = $type_parameter->_compiled_type_constraint;
7e4e1ad4 823 return sub {
180899ed 824 foreach my $x ( values %$_ ) {
825 ( $check->($x) ) || return;
826 }
827 1;
828 }
7e4e1ad4 829 }
830 )
831);
832
833$REGISTRY->add_type_constraint(
834 Moose::Meta::TypeConstraint::Parameterizable->new(
835 name => 'Maybe',
836 package_defined_in => __PACKAGE__,
837 parent => find_type_constraint('Item'),
180899ed 838 constraint => sub {1},
7e4e1ad4 839 constraint_generator => sub {
4ab662d6 840 my $type_parameter = shift;
180899ed 841 my $check = $type_parameter->_compiled_type_constraint;
7e4e1ad4 842 return sub {
180899ed 843 return 1 if not( defined($_) ) || $check->($_);
7e4e1ad4 844 return;
180899ed 845 }
7e4e1ad4 846 }
847 )
848);
849
180899ed 850my @PARAMETERIZABLE_TYPES
2c29c0e7 851 = map { $REGISTRY->get_type_constraint($_) } qw[ScalarRef ArrayRef HashRef Maybe];
180899ed 852
853sub get_all_parameterizable_types {@PARAMETERIZABLE_TYPES}
7e4e1ad4 854
4ab662d6 855sub add_parameterizable_type {
7e4e1ad4 856 my $type = shift;
180899ed 857 ( blessed $type
858 && $type->isa('Moose::Meta::TypeConstraint::Parameterizable') )
859 || __PACKAGE__->_throw_error(
860 "Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type"
861 );
7e4e1ad4 862 push @PARAMETERIZABLE_TYPES => $type;
4ab662d6 863}
7e4e1ad4 864
865## --------------------------------------------------------
d9b40005 866# end of built-in types ...
867## --------------------------------------------------------
868
943596a6 869{
870 my @BUILTINS = list_all_type_constraints();
180899ed 871 sub list_all_builtin_type_constraints {@BUILTINS}
943596a6 872}
873
6ea98933 874sub _throw_error {
6b83828f 875 shift;
6ea98933 876 require Moose;
877 unshift @_, 'Moose';
878 goto &Moose::throw_error;
879}
880
a15dff8d 8811;
882
883__END__
884
885=pod
886
887=head1 NAME
888
e522431d 889Moose::Util::TypeConstraints - Type constraint system for Moose
a15dff8d 890
891=head1 SYNOPSIS
892
893 use Moose::Util::TypeConstraints;
894
e85d2a5d 895 subtype 'Natural'
e606ae5f 896 => as 'Int'
a15dff8d 897 => where { $_ > 0 };
e85d2a5d 898
899 subtype 'NaturalLessThanTen'
2c0cbef7 900 => as 'Natural'
79592a54 901 => where { $_ < 10 }
902 => message { "This number ($_) is not less than ten!" };
e85d2a5d 903
904 coerce 'Num'
2c0cbef7 905 => from 'Str'
e85d2a5d 906 => via { 0+$_ };
907
2c0cbef7 908 enum 'RGBColors' => qw(red green blue);
a15dff8d 909
e7fcb7b2 910 no Moose::Util::TypeConstraints;
911
a15dff8d 912=head1 DESCRIPTION
913
e85d2a5d 914This module provides Moose with the ability to create custom type
6549b0d1 915constraints to be used in attribute definition.
e522431d 916
6ba6d68c 917=head2 Important Caveat
918
e85d2a5d 919This is B<NOT> a type system for Perl 5. These are type constraints,
920and they are not used by Moose unless you tell it to. No type
e7fcb7b2 921inference is performed, expressions are not typed, etc. etc. etc.
6ba6d68c 922
e7fcb7b2 923A type constraint is at heart a small "check if a value is valid"
924function. A constraint can be associated with an attribute. This
925simplifies parameter validation, and makes your code clearer to read,
926because you can refer to constraints by name.
6ba6d68c 927
2c0cbef7 928=head2 Slightly Less Important Caveat
929
e7fcb7b2 930It is B<always> a good idea to quote your type names.
004222dc 931
e7fcb7b2 932This prevents Perl from trying to execute the call as an indirect
933object call. This can be an issue when you have a subtype with the
934same name as a valid class.
2c0cbef7 935
e7fcb7b2 936For instance:
e85d2a5d 937
2c0cbef7 938 subtype DateTime => as Object => where { $_->isa('DateTime') };
939
e7fcb7b2 940will I<just work>, while this:
2c0cbef7 941
942 use DateTime;
943 subtype DateTime => as Object => where { $_->isa('DateTime') };
944
e85d2a5d 945will fail silently and cause many headaches. The simple way to solve
946this, as well as future proof your subtypes from classes which have
e7fcb7b2 947yet to have been created, is to quote the type name:
2c0cbef7 948
949 use DateTime;
d44714be 950 subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
2c0cbef7 951
6ba6d68c 952=head2 Default Type Constraints
e522431d 953
e606ae5f 954This module also provides a simple hierarchy for Perl 5 types, here is
004222dc 955that hierarchy represented visually.
e522431d 956
957 Any
e85d2a5d 958 Item
5a4c5493 959 Bool
7e4e1ad4 960 Maybe[`a]
f65cb534 961 Undef
962 Defined
5a4c5493 963 Value
5a4c5493 964 Str
f1bbe1e1 965 Num
966 Int
fcb5b0cd 967 ClassName
968 RoleName
5a4c5493 969 Ref
2c29c0e7 970 ScalarRef[`a]
7e4e1ad4 971 ArrayRef[`a]
972 HashRef[`a]
5a4c5493 973 CodeRef
974 RegexpRef
3f7376b0 975 GlobRef
fcb5b0cd 976 FileHandle
e85d2a5d 977 Object
e522431d 978
4ab662d6 979B<NOTE:> Any type followed by a type parameter C<[`a]> can be
7e4e1ad4 980parameterized, this means you can say:
981
757e07ef 982 ArrayRef[Int] # an array of integers
7e4e1ad4 983 HashRef[CodeRef] # a hash of str to CODE ref mappings
2c29c0e7 984 ScalarRef[Int] # a reference to an integer
7e4e1ad4 985 Maybe[Str] # value may be a string, may be undefined
986
4e8a0f64 987If Moose finds a name in brackets that it does not recognize as an
988existing type, it assumes that this is a class name, for example
989C<ArrayRef[DateTime]>.
990
e7fcb7b2 991B<NOTE:> Unless you parameterize a type, then it is invalid to include
992the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
993name, I<not> as a parameterization of C<ArrayRef>.
e606ae5f 994
4ab662d6 995B<NOTE:> The C<Undef> type constraint for the most part works
996correctly now, but edge cases may still exist, please use it
6549b0d1 997sparingly.
703e92fb 998
7e4e1ad4 999B<NOTE:> The C<ClassName> type constraint does a complex package
e7fcb7b2 1000existence check. This means that your class B<must> be loaded for this
1001type constraint to pass.
9af1d28b 1002
e7fcb7b2 1003B<NOTE:> The C<RoleName> constraint checks a string is a I<package
4831e2de 1004name> which is a role, like C<'MyApp::Role::Comparable'>.
ed87d4fd 1005
e606ae5f 1006=head2 Type Constraint Naming
004222dc 1007
eee1a213 1008Type name declared via this module can only contain alphanumeric
1009characters, colons (:), and periods (.).
1010
e606ae5f 1011Since the types created by this module are global, it is suggested
1012that you namespace your types just as you would namespace your
e7fcb7b2 1013modules. So instead of creating a I<Color> type for your
1014B<My::Graphics> module, you would call the type
1015I<My::Graphics::Types::Color> instead.
004222dc 1016
703e92fb 1017=head2 Use with Other Constraint Modules
1018
e7fcb7b2 1019This module can play nicely with other constraint modules with some
1020slight tweaking. The C<where> clause in types is expected to be a
1021C<CODE> reference which checks it's first argument and returns a
1022boolean. Since most constraint modules work in a similar way, it
1023should be simple to adapt them to work with Moose.
703e92fb 1024
e85d2a5d 1025For instance, this is how you could use it with
1026L<Declare::Constraints::Simple> to declare a completely new type.
703e92fb 1027
9e856c83 1028 type 'HashOfArrayOfObjects',
1029 {
1030 where => IsHashRef(
703e92fb 1031 -keys => HasLength,
9e856c83 1032 -values => IsArrayRef(IsObject)
1033 )
1034 };
703e92fb 1035
e7fcb7b2 1036For more examples see the F<t/200_examples/004_example_w_DCS.t> test
1037file.
703e92fb 1038
e85d2a5d 1039Here is an example of using L<Test::Deep> and it's non-test
1040related C<eq_deeply> function.
703e92fb 1041
e85d2a5d 1042 type 'ArrayOfHashOfBarsAndRandomNumbers'
703e92fb 1043 => where {
e85d2a5d 1044 eq_deeply($_,
703e92fb 1045 array_each(subhashof({
1046 bar => isa('Bar'),
1047 random_number => ignore()
e85d2a5d 1048 })))
703e92fb 1049 };
1050
e606ae5f 1051For a complete example see the
e7fcb7b2 1052F<t/200_examples/005_example_w_TestDeep.t> test file.
e85d2a5d 1053
a15dff8d 1054=head1 FUNCTIONS
1055
1056=head2 Type Constraint Constructors
1057
e7fcb7b2 1058The following functions are used to create type constraints. They
1059will also register the type constraints your create in a global
1060registry that is used to look types up by name.
a15dff8d 1061
cec39889 1062See the L</SYNOPSIS> for an example of how to use these.
a15dff8d 1063
6ba6d68c 1064=over 4
a15dff8d 1065
fbe1e4a5 1066=item B<< subtype 'Name' => as 'Parent' => where { } ... >>
182134e8 1067
e85d2a5d 1068This creates a named subtype.
d6e2d9a1 1069
dba9208a 1070If you provide a parent that Moose does not recognize, it will
1071automatically create a new class type constraint for this name.
1072
9e856c83 1073When creating a named type, the C<subtype> function should either be
1074called with the sugar helpers (C<where>, C<message>, etc), or with a
1075name and a hashref of parameters:
1076
1077 subtype( 'Foo', { where => ..., message => ... } );
1078
1079The valid hashref keys are C<as> (the parent), C<where>, C<message>,
1080and C<optimize_as>.
9a63faba 1081
fbe1e4a5 1082=item B<< subtype as 'Parent' => where { } ... >>
182134e8 1083
e85d2a5d 1084This creates an unnamed subtype and will return the type
1085constraint meta-object, which will be an instance of
1086L<Moose::Meta::TypeConstraint>.
a15dff8d 1087
9e856c83 1088When creating an anonymous type, the C<subtype> function should either
1089be called with the sugar helpers (C<where>, C<message>, etc), or with
1090just a hashref of parameters:
1091
1092 subtype( { where => ..., message => ... } );
1093
620db045 1094=item B<class_type ($class, ?$options)>
3fef8ce8 1095
ed87d4fd 1096Creates a new subtype of C<Object> with the name C<$class> and the
1097metaclass L<Moose::Meta::TypeConstraint::Class>.
3fef8ce8 1098
620db045 1099=item B<role_type ($role, ?$options)>
1100
ed87d4fd 1101Creates a C<Role> type constraint with the name C<$role> and the
1102metaclass L<Moose::Meta::TypeConstraint::Role>.
620db045 1103
1b2c9bda 1104=item B<maybe_type ($type)>
1105
1106Creates a type constraint for either C<undef> or something of the
1107given type.
1108
bce5d4a5 1109=item B<duck_type ($name, \@methods)>
e451e855 1110
88b68372 1111This will create a subtype of Object and test to make sure the value
bce5d4a5 1112C<can()> do the methods in C<\@methods>.
88b68372 1113
1114This is intended as an easy way to accept non-Moose objects that
1115provide a certain interface. If you're using Moose classes, we
1116recommend that you use a C<requires>-only Role instead.
e451e855 1117
1118=item B<duck_type (\@methods)>
1119
bce5d4a5 1120If passed an ARRAY reference as the only parameter instead of the
1121C<$name>, C<\@methods> pair, this will create an unnamed duck type.
1122This can be used in an attribute definition like so:
e451e855 1123
88b68372 1124 has 'cache' => (
1125 is => 'ro',
1126 isa => duck_type( [qw( get_set )] ),
1127 );
e451e855 1128
bce5d4a5 1129=item B<enum ($name, \@values)>
fcec2383 1130
e85d2a5d 1131This will create a basic subtype for a given set of strings.
1132The resulting constraint will be a subtype of C<Str> and
bce5d4a5 1133will match any of the items in C<\@values>. It is case sensitive.
cec39889 1134See the L</SYNOPSIS> for a simple example.
2c0cbef7 1135
6549b0d1 1136B<NOTE:> This is not a true proper enum type, it is simply
1137a convenient constraint builder.
2c0cbef7 1138
9f4334a1 1139=item B<enum (\@values)>
1140
bce5d4a5 1141If passed an ARRAY reference as the only parameter instead of the
1142C<$name>, C<\@values> pair, this will create an unnamed enum. This
1143can then be used in an attribute definition like so:
9f4334a1 1144
1145 has 'sort_order' => (
1146 is => 'ro',
4ab662d6 1147 isa => enum([qw[ ascending descending ]]),
9f4334a1 1148 );
1149
e7fcb7b2 1150=item B<as 'Parent'>
a15dff8d 1151
6ba6d68c 1152This is just sugar for the type constraint construction syntax.
a15dff8d 1153
e7fcb7b2 1154It takes a single argument, which is the name of a parent type.
1155
1156=item B<where { ... }>
a15dff8d 1157
6ba6d68c 1158This is just sugar for the type constraint construction syntax.
76d37e5a 1159
e7fcb7b2 1160It takes a subroutine reference as an argument. When the type
1161constraint is tested, the reference is run with the value to be tested
1162in C<$_>. This reference should return true or false to indicate
1163whether or not the constraint check passed.
e606ae5f 1164
e7fcb7b2 1165=item B<message { ... }>
76d37e5a 1166
1167This is just sugar for the type constraint construction syntax.
a15dff8d 1168
e7fcb7b2 1169It takes a subroutine reference as an argument. When the type
1170constraint fails, then the code block is run with the value provided
1171in C<$_>. This reference should return a string, which will be used in
1172the text of the exception thrown.
e606ae5f 1173
e7fcb7b2 1174=item B<optimize_as { ... }>
8ecb1fa0 1175
e85d2a5d 1176This can be used to define a "hand optimized" version of your
d44714be 1177type constraint which can be used to avoid traversing a subtype
6549b0d1 1178constraint hierarchy.
d44714be 1179
e85d2a5d 1180B<NOTE:> You should only use this if you know what you are doing,
1181all the built in types use this, so your subtypes (assuming they
d44714be 1182are shallow) will not likely need to use this.
1183
78d0edd7 1184=item B<< type 'Name' => where { } ... >>
e7fcb7b2 1185
1186This creates a base type, which has no parent.
1187
1188The C<type> function should either be called with the sugar helpers
1189(C<where>, C<message>, etc), or with a name and a hashref of
1190parameters:
1191
1192 type( 'Foo', { where => ..., message => ... } );
1193
1194The valid hashref keys are C<where>, C<message>, and C<optimize_as>.
1195
6ba6d68c 1196=back
a15dff8d 1197
0d29b772 1198=head2 Type Constraint Utilities
1199
1200=over 4
1201
1202=item B<< match_on_type $value => ( $type => \&action, ... ?\&default ) >>
1203
1a15f4a8 1204This is a utility function for doing simple type based dispatching similar to
2ae1457e 1205match/case in OCaml and case/of in Haskell. It is not as featureful as those
1a15f4a8 1206languages, nor does not it support any kind of automatic destructuring
1207bind. Here is a simple Perl pretty printer dispatching over the core Moose
1208types.
0d29b772 1209
1210 sub ppprint {
1211 my $x = shift;
1a15f4a8 1212 match_on_type $x => (
1213 HashRef => sub {
0d29b772 1214 my $hash = shift;
1a15f4a8 1215 '{ '
1216 . (
1217 join ", " => map { $_ . ' => ' . ppprint( $hash->{$_} ) }
1218 sort keys %$hash
1219 ) . ' }';
1220 },
1221 ArrayRef => sub {
0d29b772 1222 my $array = shift;
1a15f4a8 1223 '[ ' . ( join ", " => map { ppprint($_) } @$array ) . ' ]';
1224 },
1225 CodeRef => sub {'sub { ... }'},
1226 RegexpRef => sub { 'qr/' . $_ . '/' },
1227 GlobRef => sub { '*' . B::svref_2object($_)->NAME },
0d29b772 1228 Object => sub { $_->can('to_string') ? $_->to_string : $_ },
1a15f4a8 1229 ScalarRef => sub { '\\' . ppprint( ${$_} ) },
1230 Num => sub {$_},
1231 Str => sub { '"' . $_ . '"' },
1232 Undef => sub {'undef'},
1233 => sub { die "I don't know what $_ is" }
1234 );
0d29b772 1235 }
1236
e7597637 1237Or a simple JSON serializer:
1238
1239 sub to_json {
1240 my $x = shift;
1a15f4a8 1241 match_on_type $x => (
1242 HashRef => sub {
e7597637 1243 my $hash = shift;
1a15f4a8 1244 '{ '
1245 . (
1246 join ", " =>
1247 map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) }
1248 sort keys %$hash
1249 ) . ' }';
1250 },
1251 ArrayRef => sub {
e7597637 1252 my $array = shift;
1a15f4a8 1253 '[ ' . ( join ", " => map { to_json($_) } @$array ) . ' ]';
1254 },
1255 Num => sub {$_},
1256 Str => sub { '"' . $_ . '"' },
1257 Undef => sub {'null'},
1258 => sub { die "$_ is not acceptable json type" }
1259 );
e7597637 1260 }
1261
1a15f4a8 1262The matcher is done by mapping a C<$type> to an C<\&action>. The C<$type> can
1263be either a string type or a L<Moose::Meta::TypeConstraint> object, and
1264C<\&action> is a subroutine reference. This function will dispatch on the
1265first match for C<$value>. It is possible to have a catch-all by providing an
1266additional subroutine reference as the final argument to C<match_on_type>.
0d29b772 1267
1268=back
1269
6ba6d68c 1270=head2 Type Coercion Constructors
a15dff8d 1271
e7fcb7b2 1272You can define coercions for type constraints, which allow you to
1273automatically transform values to something valid for the type
1274constraint. If you ask your accessor to coerce, then Moose will run
1275the type-coercion code first, followed by the type constraint
1276check. This feature should be used carefully as it is very powerful
1277and could easily take off a limb if you are not careful.
a15dff8d 1278
cec39889 1279See the L</SYNOPSIS> for an example of how to use these.
a15dff8d 1280
6ba6d68c 1281=over 4
a15dff8d 1282
e7fcb7b2 1283=item B<< coerce 'Name' => from 'OtherName' => via { ... } >>
a15dff8d 1284
e7fcb7b2 1285This defines a coercion from one type to another. The C<Name> argument
1286is the type you are coercing I<to>.
1287
1288=item B<from 'OtherName'>
a15dff8d 1289
6ba6d68c 1290This is just sugar for the type coercion construction syntax.
1291
e7fcb7b2 1292It takes a single type name (or type object), which is the type being
1293coerced I<from>.
1294
1295=item B<via { ... }>
a15dff8d 1296
6ba6d68c 1297This is just sugar for the type coercion construction syntax.
a15dff8d 1298
e7fcb7b2 1299It takes a subroutine reference. This reference will be called with
1300the value to be coerced in C<$_>. It is expected to return a new value
1301of the proper type for the coercion.
1302
a15dff8d 1303=back
1304
e7fcb7b2 1305=head2 Creating and Finding Type Constraints
1306
1307These are additional functions for creating and finding type
1308constraints. Most of these functions are not available for
1309importing. The ones that are importable as specified.
004222dc 1310
1311=over 4
1312
e7fcb7b2 1313=item B<find_type_constraint($type_name)>
eb4c4e82 1314
e7fcb7b2 1315This function can be used to locate the L<Moose::Meta::TypeConstraint>
1316object for a named type.
eb4c4e82 1317
e7fcb7b2 1318This function is importable.
004222dc 1319
e7fcb7b2 1320=item B<register_type_constraint($type_object)>
004222dc 1321
e7fcb7b2 1322This function will register a L<Moose::Meta::TypeConstraint> with the
1323global type registry.
004222dc 1324
e7fcb7b2 1325This function is importable.
004222dc 1326
e7fcb7b2 1327=item B<normalize_type_constraint_name($type_constraint_name)>
004222dc 1328
e7fcb7b2 1329This method takes a type constraint name and returns the normalized
1330form. This removes any whitespace in the string.
004222dc 1331
e7fcb7b2 1332=item B<create_type_constraint_union($pipe_separated_types | @type_constraint_names)>
004222dc 1333
e7fcb7b2 1334This can take a union type specification like C<'Int|ArrayRef[Int]'>,
1335or a list of names. It returns a new
1336L<Moose::Meta::TypeConstraint::Union> object.
004222dc 1337
e7fcb7b2 1338=item B<create_parameterized_type_constraint($type_name)>
620db045 1339
e7fcb7b2 1340Given a C<$type_name> in the form of C<'BaseType[ContainerType]'>,
1341this will create a new L<Moose::Meta::TypeConstraint::Parameterized>
1342object. The C<BaseType> must exist already exist as a parameterizable
1343type.
620db045 1344
e7fcb7b2 1345=item B<create_class_type_constraint($class, $options)>
dabed765 1346
e7fcb7b2 1347Given a class name this function will create a new
1348L<Moose::Meta::TypeConstraint::Class> object for that class name.
004222dc 1349
e7fcb7b2 1350The C<$options> is a hash reference that will be passed to the
1351L<Moose::Meta::TypeConstraint::Class> constructor (as a hash).
620db045 1352
e7fcb7b2 1353=item B<create_role_type_constraint($role, $options)>
620db045 1354
e7fcb7b2 1355Given a role name this function will create a new
1356L<Moose::Meta::TypeConstraint::Role> object for that role name.
620db045 1357
e7fcb7b2 1358The C<$options> is a hash reference that will be passed to the
1359L<Moose::Meta::TypeConstraint::Role> constructor (as a hash).
620db045 1360
8a6c8c47 1361=item B<create_enum_type_constraint($name, $values)>
1362
1363Given a enum name this function will create a new
1364L<Moose::Meta::TypeConstraint::Enum> object for that enum name.
1365
0a6bff54 1366=item B<create_duck_type_constraint($name, $methods)>
1367
1368Given a duck type name this function will create a new
1369L<Moose::Meta::TypeConstraint::DuckType> object for that enum name.
1370
e7fcb7b2 1371=item B<find_or_parse_type_constraint($type_name)>
620db045 1372
ec4b72d2 1373Given a type name, this first attempts to find a matching constraint
e7fcb7b2 1374in the global registry.
620db045 1375
e7fcb7b2 1376If the type name is a union or parameterized type, it will create a
1377new object of the appropriate, but if given a "regular" type that does
1378not yet exist, it simply returns false.
620db045 1379
e7fcb7b2 1380When given a union or parameterized type, the member or base type must
1381already exist.
620db045 1382
e7fcb7b2 1383If it creates a new union or parameterized type, it will add it to the
1384global registry.
004222dc 1385
e7fcb7b2 1386=item B<find_or_create_isa_type_constraint($type_name)>
004222dc 1387
e7fcb7b2 1388=item B<find_or_create_does_type_constraint($type_name)>
004222dc 1389
e7fcb7b2 1390These functions will first call C<find_or_parse_type_constraint>. If
1391that function does not return a type, a new anonymous type object will
1392be created.
004222dc 1393
e7fcb7b2 1394The C<isa> variant will use C<create_class_type_constraint> and the
1395C<does> variant will use C<create_role_type_constraint>.
004222dc 1396
1397=item B<get_type_constraint_registry>
1398
e7fcb7b2 1399Returns the L<Moose::Meta::TypeConstraint::Registry> object which
004222dc 1400keeps track of all type constraints.
1401
1402=item B<list_all_type_constraints>
1403
e7fcb7b2 1404This will return a list of type constraint names in the global
1405registry. You can then fetch the actual type object using
1406C<find_type_constraint($type_name)>.
004222dc 1407
1408=item B<list_all_builtin_type_constraints>
1409
e7fcb7b2 1410This will return a list of builtin type constraints, meaning those
1411which are defined in this module. See the L<Default Type Constraints>
1412section for a complete list.
004222dc 1413
1414=item B<export_type_constraints_as_functions>
1415
e7fcb7b2 1416This will export all the current type constraints as functions into
1417the caller's namespace (C<Int()>, C<Str()>, etc). Right now, this is
1418mostly used for testing, but it might prove useful to others.
004222dc 1419
1420=item B<get_all_parameterizable_types>
1421
e7fcb7b2 1422This returns all the parameterizable types that have been registered,
1423as a list of type objects.
004222dc 1424
e7fcb7b2 1425=item B<add_parameterizable_type($type)>
004222dc 1426
1427Adds C<$type> to the list of parameterizable types
1428
1429=back
1430
a15dff8d 1431=head1 BUGS
1432
d4048ef3 1433See L<Moose/BUGS> for details on reporting bugs.
a15dff8d 1434
a15dff8d 1435=head1 AUTHOR
1436
1437Stevan Little E<lt>stevan@iinteractive.comE<gt>
1438
1439=head1 COPYRIGHT AND LICENSE
1440
7e0492d3 1441Copyright 2006-2010 by Infinity Interactive, Inc.
a15dff8d 1442
1443L<http://www.iinteractive.com>
1444
1445This library is free software; you can redistribute it and/or modify
e85d2a5d 1446it under the same terms as Perl itself.
a15dff8d 1447
81dc201f 1448=cut