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