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