use Moose;
use Moose::Meta::TypeConstraint ();
-extends 'Moose::Meta::TypeConstraint';
+#extends 'Moose::Meta::TypeConstraint';
+extends 'MooseX::Meta::TypeConstraint::Structured::Positional';
with 'MooseX::Meta::TypeConstraint::Role::Structured';
=head1 NAME
->validate(1,'hello',[2]]);
as you might expect. Basically it sucks up args to the length of it's declared
-type constraints.
+type constraints. So Optional args are validated against the definition, but if
+they are missing this does not cause a validation error.
Please keep in mind the type constraint names given in this example are for
example use only and any similarity between them, actual Type Constraints and
=cut
-has 'containing_type_constraint' => (
- is=>'ro',
- does=>'MooseX::Meta::TypeConstraint::Role::Structured',
- required=>1,
-);
+#has 'containing_type_constraint' => (
+# is=>'ro',
+# does=>'MooseX::Meta::TypeConstraint::Role::Structured',
+# required=>1,
+#);
=head2 signature
=cut
-sub _normalize_args {
- return shift->containing_type_constraint->_normalize_args(@_);
-}
+#sub _normalize_args {
+# return shift->containing_type_constraint->_normalize_args(@_);
+#}
=head2 constraint
=cut
-sub constraint {
- return shift->containing_type_constraint->constraint(@_);
-}
+#sub constraint {
+# return 1;
+ # return shift->containing_type_constraint->constraint(@_);
+#}
-=head2 parse_parameter_str ($str)
+=head2 _parse_type_parameter ($str)
Given a $string that is the parameter information part of a parameterized
constraint, parses it for internal constraint information. This is delegated
=cut
-sub parse_parameter_str {
- return shift->containing_type_constraint->parse_parameter_str(@_);
-}
+#sub _parse_type_parameter {
+# return shift->containing_type_constraint->_parse_type_parameter(@_);
+#}
=head2 signature_equals
=cut
-sub signature_equals {
- return shift->containing_type_constraint->signature_equals(@_);
-}
+#sub signature_equals {
+# return shift->containing_type_constraint->signature_equals(@_);
+#}
=head1 AUTHOR
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_parameter_str ($str)
+=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:
=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_divider = qr{\s* $divider_ops \s*}x;
+ my $structure_elements = qr{ $valid_chars+ $structure_divider $type | $union }x;
- sub parse_parameter_str {
+ $any = qr{ $union | $structure_elements+ | $type }x;
+
+ sub _parse_type_parameter {
my ($class, $type_str) = @_;
- my @type_strs = split($structure_divider, $type_str);
- return map { Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_) } @type_strs;
+ {
+ $any;
+ my @type_strs = ($type_str=~m/$union | $type/gx);
+ return map {
+ Moose::Util::TypeConstraints::find_or_create_type_constraint($_);
+ } @type_strs;
+ }
}
}
BEGIN {
use strict;
use warnings;
- use Test::More tests=>10;
+ use Test::More tests=>34;
use Test::Exception;
use_ok 'Moose::Util::TypeConstraints';
use_ok 'MooseX::Meta::TypeConstraint::Structured::Generator';
use_ok 'MooseX::Meta::TypeConstraint::Structured::Positional';
+ use_ok 'MooseX::Meta::TypeConstraint::Structured::Optional';
use_ok 'MooseX::Meta::TypeConstraint::Structured::Named';
}
+my $optional = MooseX::Meta::TypeConstraint::Structured::Generator->new(
+ name => 'Optional',
+ structured_type => 'MooseX::Meta::TypeConstraint::Structured::Optional',
+ package_defined_in => __PACKAGE__,
+ parent => find_type_constraint('ArrayRef'),
+ );
+
my $tuple = MooseX::Meta::TypeConstraint::Structured::Generator->new(
name => 'Tuple',
structured_type => 'MooseX::Meta::TypeConstraint::Structured::Positional',
parent => find_type_constraint('ArrayRef'),
);
+Moose::Util::TypeConstraints::register_type_constraint($optional);
Moose::Util::TypeConstraints::register_type_constraint($tuple);
## Make sure the new type constraints have been registered
use Moose::Util::TypeConstraints;
has 'tuple' => (is=>'rw', isa=>'Tuple[Int,Str,Int]');
+ has 'tuple_with_parameterized' => (is=>'rw', isa=>'Tuple[Int,Str,Int,ArrayRef[Int]]');
+ has 'tuple_with_optional' => (is=>'rw', isa=>'Tuple[Int,Str,Int,Optional[Int,Int]]');
+ has 'tuple_with_union' => (is=>'rw', isa=>'Tuple[Int,Str,Int|Object,Optional[Int|Object,Int]]');
}
+#use Data::Dump qw/dump/;
+#warn dump Moose::Util::TypeConstraints::list_all_type_constraints;
ok my $positioned_obj = Test::MooseX::Types::Structured::BasicAttributes->new,
=> 'Got a good object';
+ok Moose::Util::TypeConstraints::find_type_constraint('Tuple[Int,Str,Int]')
+ => 'Found expected type constraint';
+
+ok Moose::Util::TypeConstraints::find_type_constraint('Tuple[Int,Str,Int,Optional[Int,Int]]')
+ => 'Found expected type constraint';
+
+## Test tuple (Tuple[Int,Str,Int])
+
ok $positioned_obj->tuple([1,'hello',3])
=> "[1,'hello',3] properly suceeds";
}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
+## Test tuple_with_parameterized (Tuple[Int,Str,Int,ArrayRef[Int]])
+
+ok $positioned_obj->tuple_with_parameterized([1,'hello',3,[1,2,3]])
+ => "[1,'hello',3,[1,2,3]] properly suceeds";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_parameterized([1,2,'world']);
+}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_parameterized(['hello1',2,3]);
+}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_parameterized(['hello2',2,'world']);
+}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_parameterized([1,'hello',3,[1,2,'world']]);
+}, qr/Validation failed for 'ArrayRef\[Int\]'/ => "[1,'hello',3,[1,2,'world']] properly fails";
+
+
+## Test tuple_with_optional (Tuple[Int,Str,Int,Optional[Int,Int]])
+
+ok $positioned_obj->tuple_with_optional([1,'hello',3])
+ => "[1,'hello',3] properly suceeds";
+
+ok $positioned_obj->tuple_with_optional([1,'hello',3,1])
+ => "[1,'hello',3,1] properly suceeds";
+
+ok $positioned_obj->tuple_with_optional([1,'hello',3,4])
+ => "[1,'hello',3,4] properly suceeds";
+
+ok $positioned_obj->tuple_with_optional([1,'hello',3,4,5])
+ => "[1,'hello',3,4,5] properly suceeds";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_optional([1,'hello',3,4,5,6]);
+}, qr/Too Many arguments for the available type constraints/ => "[1,'hello',3,4,5,6] properly fails";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_optional([1,2,'world']);
+}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_optional(['hello1',2,3]);
+}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_optional(['hello2',2,'world']);
+}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
+
+## tuple_with_union Tuple[Int,Str,Int|Object,Optional[Int|Object,Int]]
+
+ok $positioned_obj->tuple_with_union([1,'hello',3])
+ => "[1,'hello',3] properly suceeds";
+
+ok $positioned_obj->tuple_with_union([1,'hello',3,1])
+ => "[1,'hello',3,1] properly suceeds";
+
+ok $positioned_obj->tuple_with_union([1,'hello',3,4])
+ => "[1,'hello',3,4] properly suceeds";
+
+ok $positioned_obj->tuple_with_union([1,'hello',3,4,5])
+ => "[1,'hello',3,4,5] properly suceeds";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_union([1,'hello',3,4,5,6]);
+}, qr/Too Many arguments for the available type constraints/ => "[1,'hello',3,4,5,6] properly fails";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_union([1,2,'world']);
+}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_union(['hello1',2,3]);
+}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
+
+throws_ok sub {
+ $positioned_obj->tuple_with_union(['hello2',2,'world']);
+}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
#ok Moose::Util::TypeConstraints::_detect_parameterized_type_constraint('HashRef[key1 => Int, key2=>Int, key3=>ArrayRef[Int]]')
projects / gitmo/MooseX-Types-Structured.git / commitdiff