lib/Moose/Util/TypeConstraints.pm

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