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