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