From: John Napiorkowski <jjnapiork@cpan.org>
Date: Mon, 25 Aug 2008 14:41:39 +0000 (+0000)
Subject: ugly proof of concept for parametrized types only
X-Git-Tag: 0.06~4^2~18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=54f5d4e61a7bf2a78d94eabfec4ce858e00cbf39;hp=20b6a7d178dbaa6cd1ba946e53c1a4af3a4006eb;p=gitmo%2FMooseX-Types.git

ugly proof of concept for parametrized types only
---

diff --git a/TODO b/TODO
index b261896..e66c97e 100644
--- a/TODO
+++ b/TODO
@@ -7,6 +7,8 @@ Moose::TypeConstraint->create_base(%opt);
 Moose::TypeConstraint->create_structured(%opt, %signature_opts);
 Moose::TypeConstraint->create_parameterized(%opt, %);
 
+Or some sort of pattern for type constraints that accept args?
+
 then a ...->create(%opt) that chooses one of the above????
 
 
diff --git a/lib/MooseX/Types.pm b/lib/MooseX/Types.pm
index f1dc7f5..5b64c50 100644
--- a/lib/MooseX/Types.pm
+++ b/lib/MooseX/Types.pm
@@ -300,19 +300,21 @@ yet defined.
 
 =cut
 
+use Data::Dump qw/dump/;
+
 sub type_export_generator {
     my ($class, $type, $full) = @_;
     return sub {
-        my @args = @_;
-        #use Data::Dump qw/dump/; warn dump @args if @args;
+        ## todo, this needs to be some sort of ->process_args on the actual
+        ## containing type constraints.  This is ugly proof of concept
+        if(my $param = shift @_) {
+            #my @tc_args = map { find_type_constraint($full) } @args;
+            $full = $full .'['.  $param->[0]->name .']';
+        }
+        
         my $type_constraint = find_type_constraint($full)
          || MooseX::Types::UndefinedType->new($full);
-         
-        if(@args) {
-            my $tc = $args[0]->[0];
-           # warn dump $tc;
-           # $type_constraint->type_constraint($tc);
-        }
+
         return MooseX::Types::TypeDecorator->new(type_constraint=>$type_constraint);
     };
 }
diff --git a/t/13_typedecorator.t b/t/13_typedecorator.t
index 79d95a1..396d616 100644
--- a/t/13_typedecorator.t
+++ b/t/13_typedecorator.t
@@ -44,18 +44,24 @@ is_deeply $type->arrayrefbase, [qw(d e f)],
 
 ## test arrayrefint01 normal and coercion
 
-ok $type->arrayrefint01([qw(a b c)])
- => 'Assigned arrayrefbase qw(a b c)';
+ok $type->arrayrefint01([qw(1 2 3)])
+ => 'Assigned arrayrefbase qw(1 2 3)';
  
-is_deeply $type->arrayrefint01, [qw(a b c)],
+is_deeply $type->arrayrefint01, [qw(1 2 3)],
  => 'Assigment is correct';
 
-ok $type->arrayrefint01('d.e.f')
- => 'Assigned arrayrefbase d,e,f to test coercion';
+ok $type->arrayrefint01('4.5.6')
+ => 'Assigned arrayrefbase 4.5.6 to test coercion from Str';
  
-is_deeply $type->arrayrefint01, [qw(d e f)],
+is_deeply $type->arrayrefint01, [qw(4 5 6)],
  => 'Assigment and coercion is correct';
 
+ok $type->arrayrefint01({a=>7,b=>8})
+ => 'Assigned arrayrefbase {a=>7,b=>8} to test coercion from HashRef';
+ 
+is_deeply $type->arrayrefint01, [qw(7 8)],
+ => 'Assigment and coercion is correct';
+ 
 #use Data::Dump qw/dump/;
 #warn dump  MyArrayRefInt01;
 #warn dump MyArrayRefBase->validate('aaa,bbb,ccc');
diff --git a/t/lib/DecoratorLibrary.pm b/t/lib/DecoratorLibrary.pm
index 7912331..ad3c6d2 100644
--- a/t/lib/DecoratorLibrary.pm
+++ b/t/lib/DecoratorLibrary.pm
@@ -25,7 +25,7 @@ coerce MyArrayRefInt01,
     from Str,
     via {[split('\.',$_)]},
     from HashRef,
-    via {[values(%$_)]};
+    via {[sort values(%$_)]};
     
 subtype MyArrayRefInt02,
     as MyArrayRefBase[Int];