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