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