lib/Moose/Util/TypeConstraints.pm

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