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