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.60';
  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     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     } else {
 122         return Moose::Meta::TypeConstraint::Parameterized->new(
 123             name => $base_type_tc->name . '[' . $type_parameter . ']',
 124             parent => $base_type_tc,
 125             type_parameter => find_or_create_isa_type_constraint($type_parameter),
 126         );
 127     }
 128 }
 129
 130 #should we also support optimized checks?
 131 sub create_class_type_constraint {
 132     my ( $class, $options ) = @_;
 133
 134     # too early for this check
 135     #find_type_constraint("ClassName")->check($class)
 136     #    || Moose->throw_error("Can't create a class type constraint because '$class' is not a class name");
 137
 138     my %options = (
 139         class => $class,
 140         name  => $class,
 141         %{ $options || {} },
 142     );
 143
 144     $options{name} ||= "__ANON__";
 145
 146     Moose::Meta::TypeConstraint::Class->new( %options );
 147 }
 148
 149 sub create_role_type_constraint {
 150     my ( $role, $options ) = @_;
 151
 152     # too early for this check
 153     #find_type_constraint("ClassName")->check($class)
 154     #    || Moose->throw_error("Can't create a class type constraint because '$class' is not a class name");
 155
 156     my %options = (
 157         role => $role,
 158         name => $role,
 159         %{ $options || {} },
 160     );
 161
 162     $options{name} ||= "__ANON__";
 163
 164     Moose::Meta::TypeConstraint::Role->new( %options );
 165 }
 166
 167
 168 sub find_or_create_type_constraint {
 169     my ( $type_constraint_name, $options_for_anon_type ) = @_;
 170
 171     if ( my $constraint = find_or_parse_type_constraint($type_constraint_name) ) {
 172         return $constraint;
 173     }
 174     elsif ( defined $options_for_anon_type ) {
 175         # NOTE:
 176         # if there is no $options_for_anon_type
 177         # specified, then we assume they don't
 178         # want to create one, and return nothing.
 179
 180         # otherwise assume that we should create
 181         # an ANON type with the $options_for_anon_type
 182         # options which can be passed in. It should
 183         # be noted that these don't get registered
 184         # so we need to return it.
 185         # - SL
 186         return Moose::Meta::TypeConstraint->new(
 187             name => '__ANON__',
 188             %{$options_for_anon_type}
 189         );
 190     }
 191
 192     return;
 193 }
 194
 195 sub find_or_create_isa_type_constraint {
 196     my $type_constraint_name = shift;
 197     find_or_parse_type_constraint($type_constraint_name) || create_class_type_constraint($type_constraint_name)
 198 }
 199
 200 sub find_or_create_does_type_constraint {
 201     my $type_constraint_name = shift;
 202     find_or_parse_type_constraint($type_constraint_name) || create_role_type_constraint($type_constraint_name)
 203 }
 204
 205 sub find_or_parse_type_constraint {
 206     my $type_constraint_name = normalize_type_constraint_name(shift);
 207     my $constraint;
 208
 209     if ($constraint = find_type_constraint($type_constraint_name)) {
 210         return $constraint;
 211     } elsif (_detect_type_constraint_union($type_constraint_name)) {
 212         $constraint = create_type_constraint_union($type_constraint_name);
 213     } elsif (_detect_parameterized_type_constraint($type_constraint_name)) {
 214         $constraint = create_parameterized_type_constraint($type_constraint_name);
 215     } else {
 216         return;
 217     }
 218
 219     $REGISTRY->add_type_constraint($constraint);
 220     return $constraint;
 221 }
 222
 223 sub normalize_type_constraint_name {
 224     my $type_constraint_name = shift;
 225     $type_constraint_name =~ s/\s//g;
 226     return $type_constraint_name;
 227 }
 228
 229 sub _confess {
 230     my $error = shift;
 231
 232     local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 233     Carp::confess($error);
 234 }
 235
 236 ## --------------------------------------------------------
 237 ## exported functions ...
 238 ## --------------------------------------------------------
 239
 240 sub find_type_constraint {
 241     my $type = shift;
 242
 243     if ( blessed $type and $type->isa("Moose::Meta::TypeConstraint") ) {
 244         return $type;
 245     }
 246     else {
 247         return unless $REGISTRY->has_type_constraint($type);
 248         return $REGISTRY->get_type_constraint($type);
 249     }
 250 }
 251
 252 sub register_type_constraint {
 253     my $constraint = shift;
 254     Moose->throw_error("can't register an unnamed type constraint") unless defined $constraint->name;
 255     $REGISTRY->add_type_constraint($constraint);
 256     return $constraint;
 257 }
 258
 259 # type constructors
 260
 261 sub type {
 262     splice(@_, 1, 0, undef);
 263     goto &_create_type_constraint;
 264 }
 265
 266 sub subtype {
 267     # NOTE:
 268     # this adds an undef for the name
 269     # if this is an anon-subtype:
 270     #   subtype(Num => where { $_ % 2 == 0 }) # anon 'even' subtype
 271     #     or
 272     #   subtype(Num => where { $_ % 2 == 0 }) message { "$_ must be an even number" }
 273     #
 274     # but if the last arg is not a code ref then it is a subtype
 275     # alias:
 276     #
 277     #   subtype(MyNumbers => as Num); # now MyNumbers is the same as Num
 278     # ... yeah I know it's ugly code
 279     # - SL
 280     unshift @_ => undef if scalar @_ == 2 && ( 'CODE' eq ref( $_[-1] ) );
 281     unshift @_ => undef
 282         if scalar @_ == 3 && all { ref($_) =~ /^(?:CODE|HASH)$/ } @_[ 1, 2 ];
 283     goto &_create_type_constraint;
 284 }
 285
 286 sub class_type {
 287     register_type_constraint(
 288         create_class_type_constraint(
 289             $_[0],
 290             ( defined($_[1]) ? $_[1] : () ),
 291         )
 292     );
 293 }
 294
 295 sub role_type ($;$) {
 296     register_type_constraint(
 297         create_role_type_constraint(
 298             $_[0],
 299             ( defined($_[1]) ? $_[1] : () ),
 300         )
 301     );
 302 }
 303
 304 sub coerce {
 305     my ($type_name, @coercion_map) = @_;
 306     _install_type_coercions($type_name, \@coercion_map);
 307 }
 308
 309 sub as          { @_ }
 310 sub from        { @_ }
 311 sub where   (&) { $_[0] }
 312 sub via     (&) { $_[0] }
 313
 314 sub message     (&) { +{ message   => $_[0] } }
 315 sub optimize_as (&) { +{ optimized => $_[0] } }
 316
 317 sub enum {
 318     my ($type_name, @values) = @_;
 319     # NOTE:
 320     # if only an array-ref is passed then
 321     # you get an anon-enum
 322     # - SL
 323     if (ref $type_name eq 'ARRAY' && !@values) {
 324         @values    = @$type_name;
 325         $type_name = undef;
 326     }
 327     (scalar @values >= 2)
 328         || Moose->throw_error("You must have at least two values to enumerate through");
 329     my %valid = map { $_ => 1 } @values;
 330
 331     register_type_constraint(
 332         create_enum_type_constraint(
 333             $type_name,
 334             \@values,
 335         )
 336     );
 337 }
 338
 339 sub create_enum_type_constraint {
 340     my ( $type_name, $values ) = @_;
 341
 342     Moose::Meta::TypeConstraint::Enum->new(
 343         name   => $type_name || '__ANON__',
 344         values => $values,
 345     );
 346 }
 347
 348 ## --------------------------------------------------------
 349 ## desugaring functions ...
 350 ## --------------------------------------------------------
 351
 352 sub _create_type_constraint ($$$;$$) {
 353     my $name   = shift;
 354     my $parent = shift;
 355     my $check  = shift;
 356
 357     my ( $message, $optimized );
 358     for (@_) {
 359         $message   = $_->{message}   if exists $_->{message};
 360         $optimized = $_->{optimized} if exists $_->{optimized};
 361     }
 362
 363     my $pkg_defined_in = scalar( caller(0) );
 364
 365     if ( defined $name ) {
 366         my $type = $REGISTRY->get_type_constraint($name);
 367
 368         ( $type->_package_defined_in eq $pkg_defined_in )
 369             || _confess(
 370                   "The type constraint '$name' has already been created in "
 371                 . $type->_package_defined_in
 372                 . " and cannot be created again in "
 373                 . $pkg_defined_in )
 374             if defined $type;
 375     }
 376
 377     $name = $name ? "$name" : "__ANON__";
 378
 379     my %opts = (
 380         name => $name,
 381         package_defined_in => $pkg_defined_in,
 382
 383         ( $check     ? ( constraint => $check )     : () ),
 384         ( $message   ? ( message    => $message )   : () ),
 385         ( $optimized ? ( optimized  => $optimized ) : () ),
 386     );
 387
 388     my $constraint;
 389     if ( defined $parent
 390         and $parent
 391         = blessed $parent ? $parent : find_or_parse_type_constraint($parent) )
 392     {
 393         $constraint = $parent->create_child_type(%opts);
 394     }
 395     else {
 396         $constraint = Moose::Meta::TypeConstraint->new(%opts);
 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         || Moose->throw_error("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+  (?: \[ \s* (??{$any})   \s* \] )? }x;
 441     my $type_capture_parts  = qr{ ($valid_chars+) (?: \[ \s* ((??{$any})) \s* \] )? }x;
 442     my $type_with_parameter = qr{  $valid_chars+      \[ \s* (??{$any})   \s* \]    }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             || Moose->throw_error("'$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         || Moose->throw_error("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 'Int'
 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 integers
 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:> Unless you parameterize a type, then it is invalid to
 739 include the square brackets. I.e. C<ArrayRef[]> will be
 740 literally interpreted as a type name.
 741
 742 B<NOTE:> The C<Undef> type constraint for the most part works
 743 correctly now, but edge cases may still exist, please use it
 744 sparringly.
 745
 746 B<NOTE:> The C<ClassName> type constraint does a complex package
 747 existence check. This means that your class B<must> be loaded for
 748 this type constraint to pass. I know this is not ideal for all,
 749 but it is a saner restriction than most others.
 750
 751 =head2 Type Constraint Naming
 752
 753 Since the types created by this module are global, it is suggested
 754 that you namespace your types just as you would namespace your
 755 modules. So instead of creating a I<Color> type for your B<My::Graphics>
 756 module, you would call the type I<My::Graphics::Color> instead.
 757
 758 =head2 Use with Other Constraint Modules
 759
 760 This module should play fairly nicely with other constraint
 761 modules with only some slight tweaking. The C<where> clause
 762 in types is expected to be a C<CODE> reference which checks
 763 it's first argument and returns a boolean. Since most constraint
 764 modules work in a similar way, it should be simple to adapt
 765 them to work with Moose.
 766
 767 For instance, this is how you could use it with
 768 L<Declare::Constraints::Simple> to declare a completely new type.
 769
 770   type 'HashOfArrayOfObjects'
 771       => IsHashRef(
 772           -keys   => HasLength,
 773           -values => IsArrayRef( IsObject ));
 774
 775 For more examples see the F<t/200_examples/204_example_w_DCS.t>
 776 test file.
 777
 778 Here is an example of using L<Test::Deep> and it's non-test
 779 related C<eq_deeply> function.
 780
 781   type 'ArrayOfHashOfBarsAndRandomNumbers'
 782       => where {
 783           eq_deeply($_,
 784               array_each(subhashof({
 785                   bar           => isa('Bar'),
 786                   random_number => ignore()
 787               })))
 788         };
 789
 790 For a complete example see the
 791 F<t/200_examples/205_example_w_TestDeep.t> test file.
 792
 793 =head1 FUNCTIONS
 794
 795 =head2 Type Constraint Constructors
 796
 797 The following functions are used to create type constraints.
 798 They will then register the type constraints in a global store
 799 where Moose can get to them if it needs to.
 800
 801 See the L<SYNOPSIS> for an example of how to use these.
 802
 803 =over 4
 804
 805 =item B<type ($name, $where_clause)>
 806
 807 This creates a base type, which has no parent.
 808
 809 =item B<subtype ($name, $parent, $where_clause, ?$message)>
 810
 811 This creates a named subtype.
 812
 813 =item B<subtype ($parent, $where_clause, ?$message)>
 814
 815 This creates an unnamed subtype and will return the type
 816 constraint meta-object, which will be an instance of
 817 L<Moose::Meta::TypeConstraint>.
 818
 819 =item B<class_type ($class, ?$options)>
 820
 821 Creates a type constraint with the name C<$class> and the metaclass
 822 L<Moose::Meta::TypeConstraint::Class>.
 823
 824 =item B<role_type ($role, ?$options)>
 825
 826 Creates a type constraint with the name C<$role> and the metaclass
 827 L<Moose::Meta::TypeConstraint::Role>.
 828
 829 =item B<enum ($name, @values)>
 830
 831 This will create a basic subtype for a given set of strings.
 832 The resulting constraint will be a subtype of C<Str> and
 833 will match any of the items in C<@values>. It is case sensitive.
 834 See the L<SYNOPSIS> for a simple example.
 835
 836 B<NOTE:> This is not a true proper enum type, it is simple
 837 a convient constraint builder.
 838
 839 =item B<enum (\@values)>
 840
 841 If passed an ARRAY reference instead of the C<$name>, C<@values> pair,
 842 this will create an unnamed enum. This can then be used in an attribute
 843 definition like so:
 844
 845   has 'sort_order' => (
 846       is  => 'ro',
 847       isa => enum([qw[ ascending descending ]]),
 848   );
 849
 850 =item B<as>
 851
 852 This is just sugar for the type constraint construction syntax.
 853
 854 =item B<where>
 855
 856 This is just sugar for the type constraint construction syntax.
 857
 858 Takes a block/code ref as an argument. When the type constraint is
 859 tested, the supplied code is run with the value to be tested in
 860 $_. This block should return true or false to indicate whether or not
 861 the constraint check passed.
 862
 863 =item B<message>
 864
 865 This is just sugar for the type constraint construction syntax.
 866
 867 Takes a block/code ref as an argument. When the type constraint fails,
 868 then the code block is run (with the value provided in $_). This code
 869 ref should return a string, which will be used in the text of the
 870 exception thrown.
 871
 872 =item B<optimize_as>
 873
 874 This can be used to define a "hand optimized" version of your
 875 type constraint which can be used to avoid traversing a subtype
 876 constraint heirarchy.
 877
 878 B<NOTE:> You should only use this if you know what you are doing,
 879 all the built in types use this, so your subtypes (assuming they
 880 are shallow) will not likely need to use this.
 881
 882 =back
 883
 884 =head2 Type Coercion Constructors
 885
 886 Type constraints can also contain type coercions as well. If you
 887 ask your accessor to coerce, then Moose will run the type-coercion
 888 code first, followed by the type constraint check. This feature
 889 should be used carefully as it is very powerful and could easily
 890 take off a limb if you are not careful.
 891
 892 See the L<SYNOPSIS> for an example of how to use these.
 893
 894 =over 4
 895
 896 =item B<coerce>
 897
 898 =item B<from>
 899
 900 This is just sugar for the type coercion construction syntax.
 901
 902 =item B<via>
 903
 904 This is just sugar for the type coercion construction syntax.
 905
 906 =back
 907
 908 =head2 Type Constraint Construction & Locating
 909
 910 =over 4
 911
 912 =item B<normalize_type_constraint_name ($type_constraint_name)>
 913
 914 Given a string that is expected to match a type constraint, will normalize the
 915 string so that extra whitespace and newlines are removed.
 916
 917 =item B<create_type_constraint_union ($pipe_seperated_types | @type_constraint_names)>
 918
 919 Given string with C<$pipe_seperated_types> or a list of C<@type_constraint_names>,
 920 this will return a L<Moose::Meta::TypeConstraint::Union> instance.
 921
 922 =item B<create_parameterized_type_constraint ($type_name)>
 923
 924 Given a C<$type_name> in the form of:
 925
 926   BaseType[ContainerType]
 927
 928 this will extract the base type and container type and build an instance of
 929 L<Moose::Meta::TypeConstraint::Parameterized> for it.
 930
 931 =item B<create_class_type_constraint ($class, ?$options)>
 932
 933 Given a class name it will create a new L<Moose::Meta::TypeConstraint::Class>
 934 object for that class name.
 935
 936 =item B<create_role_type_constraint ($role, ?$options)>
 937
 938 Given a role name it will create a new L<Moose::Meta::TypeConstraint::Role>
 939 object for that role name.
 940
 941 =item B<create_enum_type_constraint ($name, $values)>
 942
 943 =item B<find_or_parse_type_constraint ($type_name)>
 944
 945 This will attempt to find or create a type constraint given the a C<$type_name>.
 946 If it cannot find it in the registry, it will see if it should be a union or
 947 container type an create one if appropriate
 948
 949 =item B<find_or_create_type_constraint ($type_name, ?$options_for_anon_type)>
 950
 951 This function will first call C<find_or_parse_type_constraint> with the type name.
 952
 953 If no type is found or created, but C<$options_for_anon_type> are provided, it
 954 will create the corresponding type.
 955
 956 This was used by the C<does> and C<isa> parameters to L<Moose::Meta::Attribute>
 957 and are now superseded by C<find_or_create_isa_type_constraint> and
 958 C<find_or_create_does_type_constraint>.
 959
 960 =item B<find_or_create_isa_type_constraint ($type_name)>
 961
 962 =item B<find_or_create_does_type_constraint ($type_name)>
 963
 964 Attempts to parse the type name using L<find_or_parse_type_constraint> and if
 965 no appropriate constraint is found will create a new anonymous one.
 966
 967 The C<isa> variant will use C<create_class_type_constraint> and the C<does>
 968 variant will use C<create_role_type_constraint>.
 969
 970 =item B<find_type_constraint ($type_name)>
 971
 972 This function can be used to locate a specific type constraint
 973 meta-object, of the class L<Moose::Meta::TypeConstraint> or a
 974 derivative. What you do with it from there is up to you :)
 975
 976 =item B<register_type_constraint ($type_object)>
 977
 978 This function will register a named type constraint with the type registry.
 979
 980 =item B<get_type_constraint_registry>
 981
 982 Fetch the L<Moose::Meta::TypeConstraint::Registry> object which
 983 keeps track of all type constraints.
 984
 985 =item B<list_all_type_constraints>
 986
 987 This will return a list of type constraint names, you can then
 988 fetch them using C<find_type_constraint ($type_name)> if you
 989 want to.
 990
 991 =item B<list_all_builtin_type_constraints>
 992
 993 This will return a list of builtin type constraints, meaning,
 994 those which are defined in this module. See the section
 995 labeled L<Default Type Constraints> for a complete list.
 996
 997 =item B<export_type_constraints_as_functions>
 998
 999 This will export all the current type constraints as functions
1000 into the caller's namespace. Right now, this is mostly used for
1001 testing, but it might prove useful to others.
1002
1003 =item B<get_all_parameterizable_types>
1004
1005 This returns all the parameterizable types that have been registered.
1006
1007 =item B<add_parameterizable_type ($type)>
1008
1009 Adds C<$type> to the list of parameterizable types
1010
1011 =back
1012
1013 =head2 Namespace Management
1014
1015 =over 4
1016
1017 =item B<unimport>
1018
1019 This will remove all the type constraint keywords from the
1020 calling class namespace.
1021
1022 =back
1023
1024 =head1 BUGS
1025
1026 All complex software has bugs lurking in it, and this module is no
1027 exception. If you find a bug please either email me, or add the bug
1028 to cpan-RT.
1029
1030 =head1 AUTHOR
1031
1032 Stevan Little E<lt>stevan@iinteractive.comE<gt>
1033
1034 =head1 COPYRIGHT AND LICENSE
1035
1036 Copyright 2006-2008 by Infinity Interactive, Inc.
1037
1038 L<http://www.iinteractive.com>
1039
1040 This library is free software; you can redistribute it and/or modify
1041 it under the same terms as Perl itself.
1042
1043 =cut