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