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