[Moose-commits] r7828 - in MooseX-Types-Structured/trunk: . lib/MooseX/Meta/TypeConstraint lib/MooseX/Types t

[jnapiorkowski at code2.0beta.co.uk]

Author: jnapiorkowski
Date: 2009-03-06 11:11:19 -0800 (Fri, 06 Mar 2009)
New Revision: 7828

Modified:
   MooseX-Types-Structured/trunk/Makefile.PL
   MooseX-Types-Structured/trunk/lib/MooseX/Meta/TypeConstraint/Structured.pm
   MooseX-Types-Structured/trunk/lib/MooseX/Types/Structured.pm
   MooseX-Types-Structured/trunk/t/11-overflow.t
Log:
created a more introspective slurpy function, moved it to the tc class, and some tests

Modified: MooseX-Types-Structured/trunk/Makefile.PL
===================================================================
--- MooseX-Types-Structured/trunk/Makefile.PL	2009-03-06 17:02:42 UTC (rev 7827)
+++ MooseX-Types-Structured/trunk/Makefile.PL	2009-03-06 19:11:19 UTC (rev 7828)
@@ -11,6 +11,7 @@
 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';

Modified: MooseX-Types-Structured/trunk/lib/MooseX/Meta/TypeConstraint/Structured.pm
===================================================================
--- MooseX-Types-Structured/trunk/lib/MooseX/Meta/TypeConstraint/Structured.pm	2009-03-06 17:02:42 UTC (rev 7827)
+++ MooseX-Types-Structured/trunk/lib/MooseX/Meta/TypeConstraint/Structured.pm	2009-03-06 19:11:19 UTC (rev 7828)
@@ -227,7 +227,6 @@
     my ($get_message, $self, $value) = @_;
     my $new_value = Devel::PartialDump::dump($value);
     return $self->$get_message($new_value);
-    
 };
 
 =head1 SEE ALSO

Modified: MooseX-Types-Structured/trunk/lib/MooseX/Types/Structured.pm
===================================================================
--- MooseX-Types-Structured/trunk/lib/MooseX/Types/Structured.pm	2009-03-06 17:02:42 UTC (rev 7827)
+++ MooseX-Types-Structured/trunk/lib/MooseX/Types/Structured.pm	2009-03-06 19:11:19 UTC (rev 7828)
@@ -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 @@
     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
 

Modified: MooseX-Types-Structured/trunk/t/11-overflow.t
===================================================================
--- MooseX-Types-Structured/trunk/t/11-overflow.t	2009-03-06 17:02:42 UTC (rev 7827)
+++ MooseX-Types-Structured/trunk/t/11-overflow.t	2009-03-06 19:11:19 UTC (rev 7828)
@@ -5,24 +5,15 @@
 }
 
 use Moose::Util::TypeConstraints;
-use MooseX::Types::Structured qw(Dict Tuple);
-use MooseX::Types::Moose qw(Int Str ArrayRef HashRef);
+use MooseX::Types::Structured qw(Dict Tuple slurpy);
+use MooseX::Types::Moose qw(Int Str ArrayRef HashRef Object);
 
-
-sub merge(&$) {
-    my ($code, $tc) = @_;
-    return sub {
-        my @tail_args = @_;
-        $tc->check($code->(@tail_args));
-    }
-}
-
 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 @@
      as Tuple[
        Int,
        Str,
-       merge {+{@_}} HashRef[Int],
+       slurpy HashRef[Int],
      ];
 
 ok !$hash_tailed_tuple->check(['ss',1]), 'correct fail';
@@ -50,7 +41,7 @@
     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 @@
     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([]), '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