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