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