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