back to a regular and registered Tuple that covers most of the requirements
John Napiorkowski [Sun, 14 Sep 2008 05:49:58 +0000 (05:49 +0000)]
lib/MooseX/Meta/TypeConstraint/Structured/Positionable.pm
lib/MooseX/Types/Structured.pm
t/01-basic.t

index 3844716..7c76e4d 100755 (executable)
@@ -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,
        );                      
-
 }
 
 
index e221391..ab0a090 100644 (file)
@@ -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 : ();
index 90e31ff..f6cfbcc 100755 (executable)
@@ -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