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