use Moose;
use Moose::Meta::TypeConstraint ();
-use Moose::Util::TypeConstraints;
extends 'Moose::Meta::TypeConstraint';
with 'MooseX::Meta::TypeConstraint::Role::Structured';
MooseX::Meta::TypeConstraint::Structured::Positional - Structured Type Constraints
-=head1 VERSION
+=head1 SYNOPSIS
-0.01
-
-=cut
-
-our $VERSION = '0.01';
+The follow is example usage:
+ use Moose::Util::TypeConstraints;
+ use MooseX::Meta::TypeConstraint::Structured::Positional;
+
+ my @required = ('Str', 'Int');
+ my @optional = ('Object');
+
+ my $tc = MooseX::Meta::TypeConstraint::Structured::Positional->new(
+ name => 'Dict',
+ parent => find_type_constraint('ArrayRef'),
+ signature => [map {
+ find_type_constraint($_);
+ } @required],
+ optional_signature => [map {
+ find_type_constraint($_);
+ } @optional],
+ );
+
=head1 DESCRIPTION
-Structured type constraints let you assign an internal pattern of type
-constraints to a 'container' constraint. The goal is to make it easier to
-declare constraints like "ArrayRef[Int, Int, Str]" where the constraint is an
-ArrayRef of three elements and the internal constraint on the three is Int, Int
-and Str.
-
-To accomplish this, we add an attribute to the base L<Moose::Meta::TypeConstraint>
-to hold a L</signature>, which is a reference to a pattern of type constraints.
-We then override L</constraint> to check our incoming value to the attribute
-against this signature pattern.
-
Positionally structured Constraints expect the internal constraints to be in
-'positioned' or ArrayRef style order.
-
-=head1 TYPES
-
-The following types are defined in this class.
-
-=head2 Moose::Meta::TypeConstraint
-
-Used to make sure we can properly validate incoming signatures.
-
-=cut
-
-class_type 'Moose::Meta::TypeConstraint';
+'positioned' or ArrayRef style order. This allows you to add type constraints
+to the internal values of the Arrayref.
=head1 ATTRIBUTES
return sub {
my @args = $self->_normalize_args(shift);
my @signature = @{$self->signature};
- my @optional_signature = @{$self->optional_signature}
- if $self->has_optional_signature;
+ my @optional_signature;
+
+ if($signature[-1]->isa('MooseX::Meta::TypeConstraint::Structured::Optional')) {
+ my $optional = pop @signature;
+ @optional_signature = @{$optional->signature};
+ }
## First make sure all the required type constraints match
while( my $type_constraint = shift @signature) {
## Now test the option type constraints.
while( my $arg = shift @args) {
- my $optional_type_constraint = shift @optional_signature;
- if(my $error = $optional_type_constraint->validate($arg)) {
- confess $error;
- }
+ if(my $optional_type_constraint = shift @optional_signature) {
+ if(my $error = $optional_type_constraint->validate($arg)) {
+ confess $error;
+ }
+ } else {
+ confess "Too Many arguments for the available type constraints";
+ }
}
## If we got this far we passed!
};
}
+=head2 _parse_type_parameter ($str)
+
+Given a $string that is the parameter information part of a parameterized
+constraint, parses it for internal constraint information. For example:
+
+ MyType[Int,Int,Str]
+
+has a parameter string of "Int,Int,Str" (whitespace will automatically be
+removed during normalization that happens in L<Moose::Util::TypeConstraints>)
+and we need to convert that to ['Int','Int','Str'] which then has any type
+constraints converted to true objects.
+
+=cut
+
+{
+ use re "eval";
+
+ my $any;
+ my $valid_chars = qr{[\w:]};
+ my $type_atom = qr{ $valid_chars+ };
+
+ my $type = qr{ $valid_chars+ (?: \[ (??{$any}) \] )? }x;
+ my $type_capture_parts = qr{ ($valid_chars+) (?: \[ ((??{$any})) \] )? }x;
+ my $type_with_parameter = qr{ $valid_chars+ \[ (??{$any}) \] }x;
+
+ my $op_union = qr{ \s* \| \s* }x;
+ my $union = qr{ $type (?: $op_union $type )+ }x;
+
+ ## New Stuff for structured types.
+ my $comma = qr{,};
+ my $indirection = qr{=>};
+ my $divider_ops = qr{ $comma | $indirection }x;
+ my $structure_divider = qr{\s* $divider_ops \s*}x;
+ my $structure_elements = qr{ $valid_chars+ $structure_divider $type | $union }x;
+
+ $any = qr{ $union | $structure_elements+ | $type }x;
+
+ sub _parse_type_parameter {
+ my ($class, $type_str) = @_;
+ {
+ $any;
+ my @type_strs = ($type_str=~m/$union | $type/gx);
+ return map {
+ Moose::Util::TypeConstraints::find_or_create_type_constraint($_);
+ } @type_strs;
+ }
+ }
+}
+
=head2 signature_equals
Check that the signature equals another signature.
return 1;
}
-=head2 equals
-
-modifier to make sure equals descends into the L</signature>
-
-=cut
-
-around 'equals' => sub {
- my ($equals, $self, $compared_type_constraint) = @_;
-
- ## Make sure we are comparing typeconstraints of the same base class
- return unless $compared_type_constraint->isa(__PACKAGE__);
-
- ## Make sure the base equals is also good
- return unless $self->$equals($compared_type_constraint);
-
- ## Make sure the signatures match
- return unless $self->signature_equals($compared_type_constraint);
-
- ## If we get this far, the two are equal
- return 1;
-};
-
=head1 AUTHOR
John James Napiorkowski <jjnapiork@cpan.org>
projects / gitmo/MooseX-Types-Structured.git / blobdiff