lib/Moose/Util/TypeConstraints.pm

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