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