more tying to convert my methods to real objects

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured/Positionable.pm b/lib/MooseX/Meta/TypeConstraint/Structured/Positionable.pm
new file mode 100755 (executable)
index 0000000..3844716
--- /dev/null
+++ b/lib/MooseX/Meta/TypeConstraint/Structured/Positionable.pm
@@ -0,0 +1,32 @@
+package MooseX::Meta::TypeConstraint::Structured::Positionable;
+
+use strict;
+use warnings;
+
+use metaclass;
+
+use base 'Moose::Meta::TypeConstraint::Parameterizable';
+use Moose::Util::TypeConstraints ();
+use MooseX::Meta::TypeConstraint::Structured::Positional;
+
+
+sub parse_parameter_str {
+    my ($self, @type_strs) = @_; warn '.........................';
+    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) .']';
+       
+       return MooseX::Meta::TypeConstraint::Structured::Positional->new(
+               name => $tc_name,
+               parent => find_type_constraint('ArrayRef'),
+               package_defined_in => __PACKAGE__,
+               signature => \@contained_tcs,
+       );                      
+
+}
+
+
+1;

diff --git a/t/01-basic.t b/t/01-basic.t
new file mode 100755 (executable)
index 0000000..90e31ff
--- /dev/null
+++ b/t/01-basic.t
@@ -0,0 +1,47 @@
+BEGIN {
+       use strict;
+       use warnings;
+       use Test::More tests=>4;
+       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',
+               package_defined_in => __PACKAGE__,
+               parent => find_type_constraint('Ref'),
+       );
+
+
+type('Tuple', $tuple);
+
+
+
+
+use Data::Dump qw/dump/;
+#warn dump sort {$a cmp $b} Moose::Util::TypeConstraints::list_all_type_constraints;
+
+
+{
+       package Test::MooseX::Types::Structured::Positionable;
+       use Moose;
+       
+       has 'attr' => (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]);
+
+## 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

diff --git a/t/02-constraints.t b/t/02-constraints.t
index 21cf74a..5bceb08 100644 (file)
--- a/t/02-constraints.t
+++ b/t/02-constraints.t
@@ -254,4 +254,4 @@ lives_ok sub {
 throws_ok sub {
     $record->dict_with_tuple_with_union({key1=>1, key2=>['World',2]});
 }, qr/Validation failed for 'Int'/
- => 'Threw error on bad constraint';
\ No newline at end of file
+ => 'Threw error on bad constraint';