my $self = shift;
return sub {
my %args = $self->_normalize_args(shift);
- 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
foreach my $sig_key (keys %{$self->signature}) {
return sub {
my @args = $self->_normalize_args(shift);
my @signature = @{$self->signature};
- my @optional_signature;
-
- if($signature[-1]->isa('MooseX::Meta::TypeConstraint::Structured::Optional')) {
- my $optional = pop @signature;
- @optional_signature = @{$optional->signature};
- }
+ my @optional_signature = @{$self->optional_signature}
+ if $self->has_optional_signature;
## First make sure all the required type constraints match
while( my $type_constraint = shift @signature) {
};
}
-=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.
} @optional],
);
}
-
+use Data::Dump qw/dump/;
sub Dict($) {
my ($args, $optional) = _normalize_args(@_);
my %args = @$args;
my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
+
return MooseX::Meta::TypeConstraint::Structured::Named->new(
name => 'Dict',
parent => find_type_constraint('HashRef'),
$_ => _normalize_type_constraint($args{$_});
} keys %args},
optional_signature => {map {
+
+ warn dump $_;
+ warn dump $optional{$_};
+ warn dump _normalize_type_constraint($optional{$_});
+
$_ => _normalize_type_constraint($optional{$_});
+
} keys %optional},
);
}
}
sub _normalize_type_constraint {
- my $tc = shift @_;
-
+ my ($tc) = @_;
+
## If incoming is an object, we will assume it's something that implements
## what a type constraint is. We should probably have a Role for this...
if(defined $tc && blessed $tc) {
BEGIN {
use strict;
use warnings;
- use Test::More tests=>36;
+ use Test::More tests=>37;
use Test::Exception;
use_ok 'Moose::Util::TypeConstraints';
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]]');
- has 'dict' => (is=>'rw', isa=>'Dict[name=>Str, Age=>Int]');
- has 'dict_with_parameterized' => (is=>'rw', isa=>'Dict[name=>Str, Age=>Int, telephone=>ArrayRef[Int]]');
- has 'dict_with_optional' => (is=>'rw', isa=>'Dict[name=>Str, Age=>Int, Optional[opt1=>Str,Opt2=>Object]]');
+ has 'dict' => (is=>'rw', isa=>'Dict[name=>Str,age=>Int]');
+ has 'dict_with_parameterized' => (is=>'rw', isa=>'Dict[name=>Str, age=>Int, telephone=>ArrayRef[Int]]');
+ has 'dict_with_optional' => (is=>'rw', isa=>'Dict[name=>Str, age=>Int, Optional[opt1=>Str,opt2=>Object]]');
}
-#use Data::Dump qw/dump/;
-#warn dump Moose::Util::TypeConstraints::list_all_type_constraints;
-ok my $positioned_obj = Test::MooseX::Types::Structured::BasicAttributes->new,
+ok my $obj = Test::MooseX::Types::Structured::BasicAttributes->new,
=> 'Got a good object';
ok Moose::Util::TypeConstraints::find_type_constraint('Tuple[Int,Str,Int]')
ok Moose::Util::TypeConstraints::find_type_constraint('Tuple[Int,Str,Int,Optional[Int,Int]]')
=> 'Found expected type constraint';
+## dict Dict[name=>Str, Age=>Int]
+
+ok $obj->dict({name=>'John', age=>39})
+ => 'Dict[name=>Str, Age=>Int] properly succeeds';
+
+
+
+
+
+
## Test tuple (Tuple[Int,Str,Int])
-ok $positioned_obj->tuple([1,'hello',3])
+ok $obj->tuple([1,'hello',3])
=> "[1,'hello',3] properly suceeds";
throws_ok sub {
- $positioned_obj->tuple([1,2,'world']);
+ $obj->tuple([1,2,'world']);
}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
throws_ok sub {
- $positioned_obj->tuple(['hello1',2,3]);
+ $obj->tuple(['hello1',2,3]);
}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
throws_ok sub {
- $positioned_obj->tuple(['hello2',2,'world']);
+ $obj->tuple(['hello2',2,'world']);
}, 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]])
+ok $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']);
+ $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]);
+ $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']);
+ $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']]);
+ $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])
+ok $obj->tuple_with_optional([1,'hello',3])
=> "[1,'hello',3] properly suceeds";
-ok $positioned_obj->tuple_with_optional([1,'hello',3,1])
+ok $obj->tuple_with_optional([1,'hello',3,1])
=> "[1,'hello',3,1] properly suceeds";
-ok $positioned_obj->tuple_with_optional([1,'hello',3,4])
+ok $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])
+ok $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]);
+ $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']);
+ $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]);
+ $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']);
+ $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]]
skip "Unions not supported for string parsed type constraints" => 8;
- ok $positioned_obj->tuple_with_union([1,'hello',3])
+ ok $obj->tuple_with_union([1,'hello',3])
=> "[1,'hello',3] properly suceeds";
- ok $positioned_obj->tuple_with_union([1,'hello',3,1])
+ ok $obj->tuple_with_union([1,'hello',3,1])
=> "[1,'hello',3,1] properly suceeds";
- ok $positioned_obj->tuple_with_union([1,'hello',3,4])
+ ok $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])
+ ok $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]);
+ $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']);
+ $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]);
+ $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']);
+ $obj->tuple_with_union(['hello2',2,'world']);
}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
}
use Moose;
use MooseX::Types::Structured qw(Tuple Dict Optional);
+ use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
+ use MooseX::Types -declare => [qw(MyString)];
use Moose::Util::TypeConstraints;
- subtype 'MyString',
+ subtype MyString,
as 'Str',
where { $_=~m/abc/};
- has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
- has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
- has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']);
- has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
- has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
- has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
- has 'optional_tuple' => (is=>'rw', isa=>Tuple['Int', 'Int', Optional['Int']] );
- has 'optional_dict' => (is=>'rw', isa=>Dict[key1=>'Int', Optional[key2=>'Int']] );
- has 'dict_with_tuple_with_union' => (is=>'rw', isa=>Dict[key1=>'Str|Object', key2=>Tuple['Int','Str|Object']] );
+ has 'tuple' => (is=>'rw', isa=>Tuple[Int, Str, MyString]);
+ has 'dict' => (is=>'rw', isa=>Dict[name=>Str, age=>Int]);
+ has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>Str, age=>Maybe[Int]]);
+ has 'tuple_with_param' => (is=>'rw', isa=>Tuple[Int, Str, ArrayRef[Int]]);
+ has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple[Int, Str, Maybe[Int]]);
+ has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>Str, key2=>Tuple[Int,Str]]);
+ has 'optional_tuple' => (is=>'rw', isa=>Tuple[Int, Int, Optional[Int]] );
+ has 'optional_dict' => (is=>'rw', isa=>Dict[key1=>Int, Optional[key2=>Int]] );
+ has 'dict_with_tuple_with_union' => (is=>'rw', isa=>Dict[key1=>Str|Object, key2=>Tuple[Int,Str|Object]] );
has 'crazy' => (
is=>'rw',
## First ArrayRef Arg is the required type constraints for the top
## level Tuple.
[
- 'Int',
- 'MyString',
+ Int,
+ MyString,
## The third required element is a Dict type constraint, which
## itself has two required keys and a third optional key.
- Dict[name=>'Str',age=>'Int', Optional[visits=>'Int']],
+ Dict[name=>Str,age=>Int, Optional[visits=>Int]],
Optional[
- 'Int',
+ Int,
## This Tuple has one required type constraint and two optional.
- Tuple['Int', Optional['Int','HashRef']],
+ Tuple[Int, Optional[Int,HashRef]],
],
],
);
--- /dev/null
+BEGIN {
+ use strict;
+ use warnings;
+ use Test::More tests=>16;
+ use Test::Exception;
+ use Data::Dump qw/dump/;
+
+ use_ok 'Moose::Util::TypeConstraints';
+}
+
+Moose::Util::TypeConstraints::register_type_constraint(
+ Moose::Meta::TypeConstraint::Parameterizable->new(
+ name => 'Optional',
+ package_defined_in => __PACKAGE__,
+ parent => find_type_constraint('Item'),
+ constraint => sub { 1 },
+ constraint_generator => sub {
+ my $type_parameter = shift;
+ my $check = $type_parameter->_compiled_type_constraint;
+ return sub {
+ use Data::Dump qw/dump/;
+ warn dump @_;
+ return 1 if not(defined($_)) || $check->($_);
+ return;
+ }
+ }
+ )
+);
+
+ok Moose::Util::TypeConstraints::find_type_constraint('Optional')
+ => 'Found the Optional Type';
+
+{
+ package Test::MooseX::Types::Optional;
+ use Moose;
+
+ has 'Maybe_Int' => (is=>'rw', isa=>'Maybe[Int]');
+ has 'Maybe_ArrayRef' => (is=>'rw', isa=>'Maybe[ArrayRef]');
+ has 'Maybe_HashRef' => (is=>'rw', isa=>'Maybe[HashRef]');
+ has 'Maybe_ArrayRefInt' => (is=>'rw', isa=>'Maybe[ArrayRef[Int]]');
+ has 'Maybe_HashRefInt' => (is=>'rw', isa=>'Maybe[HashRef[Int]]');
+}
+
+ok my $obj = Test::MooseX::Types::Optional->new
+ => 'Create good test object';
+
+## Maybe[Int]
+
+ok my $Maybe_Int = Moose::Util::TypeConstraints::find_or_parse_type_constraint('Maybe[Int]')
+ => 'made TC Maybe[Int]';
+
+ok $Maybe_Int->check(1)
+ => 'passed (1)';
+
+ ok $obj->Maybe_Int(1)
+ => 'assigned (1)';
+
+ok $Maybe_Int->check()
+ => 'passed ()';
+
+ ok $obj->Maybe_Int()
+ => 'assigned ()';
+
+ok $Maybe_Int->check(0)
+ => 'passed (0)';
+
+ ok defined $obj->Maybe_Int(0)
+ => 'assigned (0)';
+
+ok $Maybe_Int->check(undef)
+ => 'passed (undef)';
+
+ ok sub {$obj->Maybe_Int(undef); 1}->()
+ => 'assigned (undef)';
+
+ok !$Maybe_Int->check("")
+ => 'failed ("")';
+
+ throws_ok sub { $obj->Maybe_Int("") },
+ qr/Attribute \(Maybe_Int\) does not pass the type constraint/
+ => 'failed assigned ("")';
+
+ok !$Maybe_Int->check("a")
+ => 'failed ("a")';
+
+ throws_ok sub { $obj->Maybe_Int("a") },
+ qr/Attribute \(Maybe_Int\) does not pass the type constraint/
+ => 'failed assigned ("a")';
+
+__END__
+
+
+ok $obj->Maybe_Int(undef)
+ => 'passed 1';
+
+ok $obj->Maybe_Int();
+
+ok $obj->Maybe_Int('')
+ => 'passed 1';
+
+ok $obj->Maybe_Int('a')
+ => 'passed 1';
+
+
+
+
+ok $obj->tuple([1,'hello',3])
+ => "[1,'hello',3] properly suceeds";
+
+throws_ok sub {
+ $obj->tuple([1,2,'world']);
+}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
+
+throws_ok sub {
+ $obj->tuple(['hello1',2,3]);
+}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
+
+throws_ok sub {
+ $obj->tuple(['hello2',2,'world']);
+}, 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 $obj->tuple_with_parameterized([1,'hello',3,[1,2,3]])
+ => "[1,'hello',3,[1,2,3]] properly suceeds";
+
+throws_ok sub {
+ $obj->tuple_with_parameterized([1,2,'world']);
+}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
+
+throws_ok sub {
+ $obj->tuple_with_parameterized(['hello1',2,3]);
+}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
+
+throws_ok sub {
+ $obj->tuple_with_parameterized(['hello2',2,'world']);
+}, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
+
+throws_ok sub {
+ $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 $obj->tuple_with_optional([1,'hello',3])
+ => "[1,'hello',3] properly suceeds";
+
+ok $obj->tuple_with_optional([1,'hello',3,1])
+ => "[1,'hello',3,1] properly suceeds";
+
+ok $obj->tuple_with_optional([1,'hello',3,4])
+ => "[1,'hello',3,4] properly suceeds";
+
+ok $obj->tuple_with_optional([1,'hello',3,4,5])
+ => "[1,'hello',3,4,5] properly suceeds";
+
+throws_ok sub {
+ $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 {
+ $obj->tuple_with_optional([1,2,'world']);
+}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
+
+throws_ok sub {
+ $obj->tuple_with_optional(['hello1',2,3]);
+}, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
+
+throws_ok sub {
+ $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]]
+
+SKIP: {
+
+ skip "Unions not supported for string parsed type constraints" => 8;
+
+ ok $obj->tuple_with_union([1,'hello',3])
+ => "[1,'hello',3] properly suceeds";
+
+ ok $obj->tuple_with_union([1,'hello',3,1])
+ => "[1,'hello',3,1] properly suceeds";
+
+ ok $obj->tuple_with_union([1,'hello',3,4])
+ => "[1,'hello',3,4] properly suceeds";
+
+ ok $obj->tuple_with_union([1,'hello',3,4,5])
+ => "[1,'hello',3,4,5] properly suceeds";
+
+ throws_ok sub {
+ $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 {
+ $obj->tuple_with_union([1,2,'world']);
+ }, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails";
+
+ throws_ok sub {
+ $obj->tuple_with_union(['hello1',2,3]);
+ }, qr/Validation failed for 'Int' failed with value hello1/ => "['hello',2,3] properly fails";
+
+ throws_ok sub {
+ $obj->tuple_with_union(['hello2',2,'world']);
+ }, qr/Validation failed for 'Int' failed with value hello2/ => "['hello',2,'world'] properly fails";
+}
+
projects / gitmo/MooseX-Types-Structured.git / commitdiff