lib/Moose/Util/TypeConstraints.pm

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