created a more introspective slurpy function, moved it to the tc class, and some...

diff --git a/Makefile.PL b/Makefile.PL
index f74e9dd..4ec2b00 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -11,6 +11,7 @@ license 'perl';
 requires 'Moose' => '0.63';
 requires 'MooseX::Types' => '0.08';
 requires 'Devel::PartialDump' => '0.07';
+requires 'Sub::Exporter' => '0.982';
 
 ## Testing dependencies
 build_requires 'Test::More' => '0.70';

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured.pm b/lib/MooseX/Meta/TypeConstraint/Structured.pm
index 34ab8e1..c15b647 100644 (file)
--- a/lib/MooseX/Meta/TypeConstraint/Structured.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Structured.pm
@@ -227,7 +227,6 @@ around 'get_message' => sub {
     my ($get_message, $self, $value) = @_;
     my $new_value = Devel::PartialDump::dump($value);
     return $self->$get_message($new_value);
-    
 };
 
 =head1 SEE ALSO

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index ddf09ef..f440d5d 100644 (file)
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -1,9 +1,11 @@
 package MooseX::Types::Structured;
 
 use 5.008;
+
 use Moose::Util::TypeConstraints;
 use MooseX::Meta::TypeConstraint::Structured;
 use MooseX::Types -declare => [qw(Dict Tuple Optional)];
+use Sub::Exporter -setup => { exports => [ qw(Dict Tuple Optional slurpy) ] };
 
 our $VERSION = '0.07';
 our $AUTHORITY = 'cpan:JJNAPIORK';
@@ -689,6 +691,27 @@ OPTIONAL: {
     Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
 }
 
+sub slurpy($) {
+       my $tc = shift @_;
+       ## we don't want to force the TC to be a Moose::Meta::TypeConstraint, we
+       ## just want to make sure it provides the minimum needed bits to function.
+       if($tc and ref $tc and $tc->can('check') and $tc->can('is_subtype_of') ) {
+               return sub {
+                       if($tc->is_subtype_of('HashRef')) {
+                               return $tc->check(+{@_});
+                       } elsif($tc->is_subtype_of('ArrayRef')) {
+                               return $tc->check([@_]);
+                       } else {
+                               return;
+                       }
+               };              
+       } else {
+               ## For now just pass it all to check and cross our fingers
+               return sub {
+                       return $tc->check(@_);
+               };      
+       }
+}
 
 =head1 SEE ALSO
 

diff --git a/t/11-overflow.t b/t/11-overflow.t
index 3e8d0f4..94328eb 100644 (file)
--- a/t/11-overflow.t
+++ b/t/11-overflow.t
@@ -5,24 +5,15 @@ BEGIN {
 }
 
 use Moose::Util::TypeConstraints;
-use MooseX::Types::Structured qw(Dict Tuple);
-use MooseX::Types::Moose qw(Int Str ArrayRef HashRef);
-
-
-sub merge(&$) {
-    my ($code, $tc) = @_;
-    return sub {
-        my @tail_args = @_;
-        $tc->check($code->(@tail_args));
-    }
-}
+use MooseX::Types::Structured qw(Dict Tuple slurpy);
+use MooseX::Types::Moose qw(Int Str ArrayRef HashRef Object);
 
 my $array_tailed_tuple =
     subtype 'array_tailed_tuple',
      as Tuple[
         Int,
         Str,
-        merge {[@_]} ArrayRef[Int],
+        slurpy ArrayRef[Int],
      ];
   
 ok !$array_tailed_tuple->check(['ss',1]), 'correct fail';
@@ -36,7 +27,7 @@ my $hash_tailed_tuple =
      as Tuple[
        Int,
        Str,
-       merge {+{@_}} HashRef[Int],
+       slurpy HashRef[Int],
      ];
 
 ok !$hash_tailed_tuple->check(['ss',1]), 'correct fail';
@@ -50,7 +41,7 @@ my $hash_tailed_dict =
     as Dict[
       name=>Str,
       age=>Int,
-       merge {+{@_}} HashRef[Int],
+      slurpy HashRef[Int],
     ];
     
 ok !$hash_tailed_dict->check({name=>'john',age=>'napiorkowski'}), 'correct fail';
@@ -64,7 +55,7 @@ my $array_tailed_dict =
     as Dict[
       name=>Str,
       age=>Int,
-      merge {[@_]} ArrayRef[Int],
+      slurpy ArrayRef[Int],
     ];
     
 ok !$array_tailed_dict->check({name=>'john',age=>'napiorkowski'}), 'correct fail';
@@ -72,3 +63,17 @@ ok $array_tailed_dict->check({name=>'Vanessa Li', age=>35}), 'correct pass';
 ok !$array_tailed_dict->check([]), 'correct fail';
 ok $array_tailed_dict->check({name=>'Vanessa Li', age=>35, 1,2}), 'correct pass with tail';
 ok !$array_tailed_dict->check({name=>'Vanessa Li', age=>35, 1, "hello"}), 'correct fail with tail';
+
+my $insane_tc =
+       subtype 'insane_tc',
+       as Tuple[
+               Object,
+               slurpy Dict[
+                       name=>Str,
+                       age=>Int,
+                       slurpy ArrayRef[Int],
+               ]
+       ];
+       
+ok $insane_tc->check([$insane_tc, name=>"John", age=>25, 1,2,3]),
+  'validated: [$insane_tc, name=>"John", age=>25, 1,2,3]';
\ No newline at end of file