From: John Napiorkowski <jjnapiork@cpan.org>
Date: Thu, 21 Aug 2008 19:36:31 +0000 (+0000)
Subject: first shot at some regex to parse the attribute isa option
X-Git-Tag: 0.01~31
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a49ce94b6efb4baf42763a1acf8e3b8563bb2a17;p=gitmo%2FMooseX-Types-Structured.git

first shot at some regex to parse the attribute isa option
---

diff --git a/t/constraints.t b/t/constraints.t
index ea0130f..3a88cf7 100644
--- a/t/constraints.t
+++ b/t/constraints.t
@@ -95,8 +95,6 @@ BEGIN {
             ],        
         )
     );
-    
-    ##has 'sugered' => ();
 }
 
 ## Instantiate a new test object
@@ -283,6 +281,4 @@ throws_ok sub {
     $record->optional_dict({key1=>1,key2=>'bad'});   
 }, qr/Validation failed for 'Int'/
  => 'Properly failed for bad value in optional bit';
- 
- 
  
\ No newline at end of file
diff --git a/t/suger.t b/t/suger.t
new file mode 100644
index 0000000..b19fbb6
--- /dev/null
+++ b/t/suger.t
@@ -0,0 +1,55 @@
+BEGIN {
+	use strict;
+	use warnings;
+	use Test::More tests=>3;
+}
+ 
+{
+    ## Copied from Moose::Util::TypeConstraints
+    use re "eval";
+
+    my $any;
+    my $valid_chars = qr{[\w:]};
+    my $type_atom   = qr{ $valid_chars+ };
+    
+    my $type                = qr{  $valid_chars+  (?: \[  (??{$any})  \] )? }x;
+    my $type_capture_parts  = qr{ ($valid_chars+) (?: \[ ((??{$any})) \] )? }x;
+    my $type_with_parameter = qr{  $valid_chars+      \[  (??{$any})  \]    }x;
+    
+    my $op_union = qr{ \s* \| \s* }x;
+    my $union    = qr{ $type (?: $op_union $type )+ }x;
+    
+    ## New Stuff for structured types.
+    my $comma = qr{,};
+    my $indirection = qr{=>};
+    my $divider_tokens = qr{ $comma | $indirection }x;
+    my $structure_divider = qr{\s* $divider_tokens \s*}x;    
+    my $structure_elements = qr{ ($type $structure_divider*)+ }x;
+
+    $any = qr{ $type | $union | $structure_elements }x;
+    
+    ## New Proposed methods to parse and create
+    sub _parse_structured_type_constraint {
+        { no warnings 'void'; $any; } # force capture of interpolated lexical
+        
+        my($base, $elements) = ($_[0] =~ m{ $type_capture_parts }x);
+        return ($base, [split($structure_divider, $elements)]);
+    }
+    
+    is_deeply
+        [_parse_structured_type_constraint('ArrayRef[Int,Str]')],
+        ["ArrayRef", ["Int", "Str"]]
+     => 'Correctly parsed ArrayRef[Int,Str]';
+     
+    is_deeply
+        [_parse_structured_type_constraint('ArrayRef[ArrayRef[Int],Str]')],
+        ["ArrayRef", ["ArrayRef[Int]", "Str"]]
+     => 'Correctly parsed ArrayRef[ArrayRef[Int],Str]';
+         
+    is_deeply 
+        [_parse_structured_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