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     my $constraint;
 217
 218     if ($constraint = find_type_constraint($type_constraint_name)) {
 219         return $constraint;
 220     } elsif (_detect_type_constraint_union($type_constraint_name)) {
 221         $constraint = create_type_constraint_union($type_constraint_name);
 222     } elsif (_detect_parameterized_type_constraint($type_constraint_name)) {
 223         $constraint = create_parameterized_type_constraint($type_constraint_name);
 224     } else {
 225         return;
 226     }
 227
 228     $REGISTRY->add_type_constraint($constraint);
 229     return $constraint;
 230 }
 231
 232 ## --------------------------------------------------------
 233 ## exported functions ...
 234 ## --------------------------------------------------------
 235
 236 sub find_type_constraint ($) {
 237     my $type = shift;
 238
 239     if ( blessed $type and $type->isa("Moose::Meta::TypeConstraint") ) {
 240         return $type;
 241     }
 242     else {
 243         return unless $REGISTRY->has_type_constraint($type);
 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 'Int'
 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:> Unless you parameterize a type, then it is invalid to
 738 include the square brackets. I.e. C<ArrayRef[]> will be
 739 literally interpreted as a type name.
 740
 741 B<NOTE:> The C<Undef> type constraint for the most part works
 742 correctly now, but edge cases may still exist, please use it
 743 sparringly.
 744
 745 B<NOTE:> The C<ClassName> type constraint does a complex package
 746 existence check. This means that your class B<must> be loaded for
 747 this type constraint to pass. I know this is not ideal for all,
 748 but it is a saner restriction than most others.
 749
 750 =head2 Type Constraint Naming
 751
 752 Since the types created by this module are global, it is suggested
 753 that you namespace your types just as you would namespace your
 754 modules. So instead of creating a I<Color> type for your B<My::Graphics>
 755 module, you would call the type I<My::Graphics::Color> instead.
 756
 757 =head2 Use with Other Constraint Modules
 758
 759 This module should play fairly nicely with other constraint
 760 modules with only some slight tweaking. The C<where> clause
 761 in types is expected to be a C<CODE> reference which checks
 762 it's first argument and returns a boolean. Since most constraint
 763 modules work in a similar way, it should be simple to adapt
 764 them to work with Moose.
 765
 766 For instance, this is how you could use it with
 767 L<Declare::Constraints::Simple> to declare a completely new type.
 768
 769   type 'HashOfArrayOfObjects'
 770       => IsHashRef(
 771           -keys   => HasLength,
 772           -values => IsArrayRef( IsObject ));
 773
 774 For more examples see the F<t/200_examples/204_example_w_DCS.t>
 775 test file.
 776
 777 Here is an example of using L<Test::Deep> and it's non-test
 778 related C<eq_deeply> function.
 779
 780   type 'ArrayOfHashOfBarsAndRandomNumbers'
 781       => where {
 782           eq_deeply($_,
 783               array_each(subhashof({
 784                   bar           => isa('Bar'),
 785                   random_number => ignore()
 786               })))
 787         };
 788
 789 For a complete example see the
 790 F<t/200_examples/205_example_w_TestDeep.t> test file.
 791
 792 =head1 FUNCTIONS
 793
 794 =head2 Type Constraint Constructors
 795
 796 The following functions are used to create type constraints.
 797 They will then register the type constraints in a global store
 798 where Moose can get to them if it needs to.
 799
 800 See the L<SYNOPSIS> for an example of how to use these.
 801
 802 =over 4
 803
 804 =item B<type ($name, $where_clause)>
 805
 806 This creates a base type, which has no parent.
 807
 808 =item B<subtype ($name, $parent, $where_clause, ?$message)>
 809
 810 This creates a named subtype.
 811
 812 =item B<subtype ($parent, $where_clause, ?$message)>
 813
 814 This creates an unnamed subtype and will return the type
 815 constraint meta-object, which will be an instance of
 816 L<Moose::Meta::TypeConstraint>.
 817
 818 =item B<class_type ($class, ?$options)>
 819
 820 Creates a type constraint with the name C<$class> and the metaclass
 821 L<Moose::Meta::TypeConstraint::Class>.
 822
 823 =item B<role_type ($role, ?$options)>
 824
 825 Creates a type constraint with the name C<$role> and the metaclass
 826 L<Moose::Meta::TypeConstraint::Role>.
 827
 828 =item B<enum ($name, @values)>
 829
 830 This will create a basic subtype for a given set of strings.
 831 The resulting constraint will be a subtype of C<Str> and
 832 will match any of the items in C<@values>. It is case sensitive.
 833 See the L<SYNOPSIS> for a simple example.
 834
 835 B<NOTE:> This is not a true proper enum type, it is simple
 836 a convient constraint builder.
 837
 838 =item B<enum (\@values)>
 839
 840 If passed an ARRAY reference instead of the C<$name>, C<@values> pair,
 841 this will create an unnamed enum. This can then be used in an attribute
 842 definition like so:
 843
 844   has 'sort_order' => (
 845       is  => 'ro',
 846       isa => enum([qw[ ascending descending ]]),
 847   );
 848
 849 =item B<as>
 850
 851 This is just sugar for the type constraint construction syntax.
 852
 853 =item B<where>
 854
 855 This is just sugar for the type constraint construction syntax.
 856
 857 Takes a block/code ref as an argument. When the type constraint is
 858 tested, the supplied code is run with the value to be tested in
 859 $_. This block should return true or false to indicate whether or not
 860 the constraint check passed.
 861
 862 =item B<message>
 863
 864 This is just sugar for the type constraint construction syntax.
 865
 866 Takes a block/code ref as an argument. When the type constraint fails,
 867 then the code block is run (with the value provided in $_). This code
 868 ref should return a string, which will be used in the text of the
 869 exception thrown.
 870
 871 =item B<optimize_as>
 872
 873 This can be used to define a "hand optimized" version of your
 874 type constraint which can be used to avoid traversing a subtype
 875 constraint heirarchy.
 876
 877 B<NOTE:> You should only use this if you know what you are doing,
 878 all the built in types use this, so your subtypes (assuming they
 879 are shallow) will not likely need to use this.
 880
 881 =back
 882
 883 =head2 Type Coercion Constructors
 884
 885 Type constraints can also contain type coercions as well. If you
 886 ask your accessor to coerce, then Moose will run the type-coercion
 887 code first, followed by the type constraint check. This feature
 888 should be used carefully as it is very powerful and could easily
 889 take off a limb if you are not careful.
 890
 891 See the L<SYNOPSIS> for an example of how to use these.
 892
 893 =over 4
 894
 895 =item B<coerce>
 896
 897 =item B<from>
 898
 899 This is just sugar for the type coercion construction syntax.
 900
 901 =item B<via>
 902
 903 This is just sugar for the type coercion construction syntax.
 904
 905 =back
 906
 907 =head2 Type Constraint Construction & Locating
 908
 909 =over 4
 910
 911 =item B<create_type_constraint_union ($pipe_seperated_types | @type_constraint_names)>
 912
 913 Given string with C<$pipe_seperated_types> or a list of C<@type_constraint_names>,
 914 this will return a L<Moose::Meta::TypeConstraint::Union> instance.
 915
 916 =item B<create_parameterized_type_constraint ($type_name)>
 917
 918 Given a C<$type_name> in the form of:
 919
 920   BaseType[ContainerType]
 921
 922 this will extract the base type and container type and build an instance of
 923 L<Moose::Meta::TypeConstraint::Parameterized> for it.
 924
 925 =item B<create_class_type_constraint ($class, ?$options)>
 926
 927 Given a class name it will create a new L<Moose::Meta::TypeConstraint::Class>
 928 object for that class name.
 929
 930 =item B<create_role_type_constraint ($role, ?$options)>
 931
 932 Given a role name it will create a new L<Moose::Meta::TypeConstraint::Role>
 933 object for that role name.
 934
 935 =item B<create_enum_type_constraint ($name, $values)>
 936
 937 =item B<find_or_parse_type_constraint ($type_name)>
 938
 939 This will attempt to find or create a type constraint given the a C<$type_name>.
 940 If it cannot find it in the registry, it will see if it should be a union or
 941 container type an create one if appropriate
 942
 943 =item B<find_or_create_type_constraint ($type_name, ?$options_for_anon_type)>
 944
 945 This function will first call C<find_or_parse_type_constraint> with the type name.
 946
 947 If no type is found or created, but C<$options_for_anon_type> are provided, it
 948 will create the corresponding type.
 949
 950 This was used by the C<does> and C<isa> parameters to L<Moose::Meta::Attribute>
 951 and are now superseded by C<find_or_create_isa_type_constraint> and
 952 C<find_or_create_does_type_constraint>.
 953
 954 =item B<find_or_create_isa_type_constraint ($type_name)>
 955
 956 =item B<find_or_create_does_type_constraint ($type_name)>
 957
 958 Attempts to parse the type name using L<find_or_parse_type_constraint> and if
 959 no appropriate constraint is found will create a new anonymous one.
 960
 961 The C<isa> variant will use C<create_class_type_constraint> and the C<does>
 962 variant will use C<create_role_type_constraint>.
 963
 964 =item B<find_type_constraint ($type_name)>
 965
 966 This function can be used to locate a specific type constraint
 967 meta-object, of the class L<Moose::Meta::TypeConstraint> or a
 968 derivative. What you do with it from there is up to you :)
 969
 970 =item B<register_type_constraint ($type_object)>
 971
 972 This function will register a named type constraint with the type registry.
 973
 974 =item B<get_type_constraint_registry>
 975
 976 Fetch the L<Moose::Meta::TypeConstraint::Registry> object which
 977 keeps track of all type constraints.
 978
 979 =item B<list_all_type_constraints>
 980
 981 This will return a list of type constraint names, you can then
 982 fetch them using C<find_type_constraint ($type_name)> if you
 983 want to.
 984
 985 =item B<list_all_builtin_type_constraints>
 986
 987 This will return a list of builtin type constraints, meaning,
 988 those which are defined in this module. See the section
 989 labeled L<Default Type Constraints> for a complete list.
 990
 991 =item B<export_type_constraints_as_functions>
 992
 993 This will export all the current type constraints as functions
 994 into the caller's namespace. Right now, this is mostly used for
 995 testing, but it might prove useful to others.
 996
 997 =item B<get_all_parameterizable_types>
 998
 999 This returns all the parameterizable types that have been registered.
1000
1001 =item B<add_parameterizable_type ($type)>
1002
1003 Adds C<$type> to the list of parameterizable types
1004
1005 =back
1006
1007 =head2 Namespace Management
1008
1009 =over 4
1010
1011 =item B<unimport>
1012
1013 This will remove all the type constraint keywords from the
1014 calling class namespace.
1015
1016 =back
1017
1018 =head1 BUGS
1019
1020 All complex software has bugs lurking in it, and this module is no
1021 exception. If you find a bug please either email me, or add the bug
1022 to cpan-RT.
1023
1024 =head1 AUTHOR
1025
1026 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1027
1028 =head1 COPYRIGHT AND LICENSE
1029
1030 Copyright 2006-2008 by Infinity Interactive, Inc.
1031
1032 L<http://www.iinteractive.com>
1033
1034 This library is free software; you can redistribute it and/or modify
1035 it under the same terms as Perl itself.
1036
1037 =cut