lib/Moose/Util/TypeConstraints.pm

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