From: John Napiorkowski Date: Sun, 14 Sep 2008 05:49:58 +0000 (+0000) Subject: back to a regular and registered Tuple that covers most of the requirements X-Git-Tag: 0.01~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types-Structured.git;a=commitdiff_plain;h=011bacc617976a629104ae622442a70679a44a34 back to a regular and registered Tuple that covers most of the requirements --- diff --git a/lib/MooseX/Meta/TypeConstraint/Structured/Positionable.pm b/lib/MooseX/Meta/TypeConstraint/Structured/Positionable.pm index 3844716..7c76e4d 100755 --- a/lib/MooseX/Meta/TypeConstraint/Structured/Positionable.pm +++ b/lib/MooseX/Meta/TypeConstraint/Structured/Positionable.pm @@ -9,23 +9,27 @@ use base 'Moose::Meta::TypeConstraint::Parameterizable'; use Moose::Util::TypeConstraints (); use MooseX::Meta::TypeConstraint::Structured::Positional; + my $comma = qr{,}; + my $indirection = qr{=>}; + my $divider_ops = qr{ $comma | $indirection }x; + my $structure_divider = qr{\s* $divider_ops \s*}x; sub parse_parameter_str { - my ($self, @type_strs) = @_; warn '.........................'; + my ($self, $type_str) = @_; + my @type_strs = split($structure_divider, $type_str); return map {Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_)} @type_strs; } sub parameterize { - my ($self, @contained_tcs) = @_; warn ',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,'; - my $tc_name = $self->name .'['. join(', ', map {$_->name} @contained_tcs) .']'; + my ($self, @contained_tcs) = @_; + my $tc_name = $self->name .'['. join(',', map {$_->name} @contained_tcs) .']'; return MooseX::Meta::TypeConstraint::Structured::Positional->new( name => $tc_name, - parent => find_type_constraint('ArrayRef'), + parent => Moose::Util::TypeConstraints::find_type_constraint('ArrayRef'), package_defined_in => __PACKAGE__, signature => \@contained_tcs, ); - } diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm index e221391..ab0a090 100644 --- a/lib/MooseX/Types/Structured.pm +++ b/lib/MooseX/Types/Structured.pm @@ -4,10 +4,10 @@ use Moose; use Moose::Util::TypeConstraints; use MooseX::Meta::TypeConstraint::Structured::Positional; use MooseX::Meta::TypeConstraint::Structured::Named; -#use MooseX::Types::Moose qw(); -#use MooseX::Types -declare => [qw( Dict Tuple Optional )]; - use Sub::Exporter - -setup => { exports => [ qw(Dict Tuple Optional) ] }; + +use MooseX::Types -declare => [qw(Dict Tuple Optional)]; + #use Sub::Exporter + # -setup => { exports => [ qw( Optional) ] }; our $VERSION = '0.01'; our $AUTHORITY = 'cpan:JJNAPIORK'; @@ -113,11 +113,24 @@ This class defines the following types and subtypes. =cut +use MooseX::Meta::TypeConstraint::Structured::Positionable; + +my $tuple = MooseX::Meta::TypeConstraint::Structured::Positionable->new( + name => 'Tuple', + package_defined_in => __PACKAGE__, + parent => find_type_constraint('Ref'), + ); + +Moose::Util::TypeConstraints::register_type_constraint($tuple); + +subtype Tuple, as 'Tuple'; + + sub Optional($) { return bless {args=>shift}, 'MooseX::Types::Optional'; } -sub Tuple($) { +sub TupleX($) { my ($args, $optional) = _normalize_args(@_); my @args = @$args; my @optional = ref $optional eq 'ARRAY' ? @$optional : (); @@ -135,7 +148,7 @@ sub Tuple($) { ); } -sub Dict($) { +sub DictX($) { my ($args, $optional) = _normalize_args(@_); my %args = @$args; my %optional = ref $optional eq 'ARRAY' ? @$optional : (); diff --git a/t/01-basic.t b/t/01-basic.t index 90e31ff..f6cfbcc 100755 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -1,15 +1,13 @@ BEGIN { use strict; use warnings; - use Test::More tests=>4; + use Test::More tests=>8; use Test::Exception; use_ok 'Moose::Util::TypeConstraints'; use_ok 'MooseX::Meta::TypeConstraint::Structured::Positionable'; } -ok my $REGISTRY = Moose::Meta::TypeConstraint::Registry->new - => 'Got a registry'; my $tuple = MooseX::Meta::TypeConstraint::Structured::Positionable->new( name => 'Tuple', @@ -17,31 +15,49 @@ my $tuple = MooseX::Meta::TypeConstraint::Structured::Positionable->new( parent => find_type_constraint('Ref'), ); +Moose::Util::TypeConstraints::register_type_constraint($tuple); -type('Tuple', $tuple); +## Make sure the new type constraints have been registered - - - -use Data::Dump qw/dump/; -#warn dump sort {$a cmp $b} Moose::Util::TypeConstraints::list_all_type_constraints; +ok Moose::Util::TypeConstraints::find_type_constraint('Tuple') + => 'Found the Tuple Type'; { package Test::MooseX::Types::Structured::Positionable; - use Moose; - has 'attr' => (is=>'rw', isa=>'Tuple[Int,Str,Int]'); + use Moose; + use Moose::Util::TypeConstraints; + has 'tuple' => (is=>'rw', isa=>'Tuple[Int,Str,Int]'); } + ok my $positioned_obj = Test::MooseX::Types::Structured::Positionable->new, => 'Got a good object'; -## should be good -$positioned_obj->attr([1,'hello',3]); +ok $positioned_obj->tuple([1,'hello',3]) + => "[1,'hello',3] properly suceeds"; + +throws_ok sub { + $positioned_obj->tuple([1,2,'world']); +}, qr/Validation failed for 'Int' failed with value world/ => "[1,2,'world'] properly fails"; -## should all fail -$positioned_obj->attr([1,2,'world']); -$positioned_obj->attr(['hello',2,3]); -$positioned_obj->attr(['hello',2,'world']); \ No newline at end of file +throws_ok sub { + $positioned_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']); +}, 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]]') +# => 'detected correctly'; + +#is_deeply +# [Moose::Util::TypeConstraints::_parse_parameterized_type_constraint('HashRef[key1 => Int, key2=>Int, key3=>ArrayRef[Int]]')], +# ["HashRef", "key1", "Int", "key2", "Int", "key3", "ArrayRef[Int]"] +# => 'Correctly parsed HashRef[key1 => Int, key2=>Int, key3=>ArrayRef[Int]]'; \ No newline at end of file