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