From: Daisuke Maki (lestrrat) <daisuke@endeworks.jp>
Date: Tue, 10 Mar 2009 05:36:34 +0000 (+0900)
Subject: implement Maybe
X-Git-Tag: 0.20~46
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a510e63c7acd5fa667d7dce5f90b3fd07913e2d3;p=gitmo%2FMouse.git

implement Maybe
---

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index b3e3e50..80ddb51 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -199,8 +199,13 @@ sub _build_type_constraint {
         # parameterized
         my $constraint = $1;
         my $param      = $2;
-        my $parent     = _build_type_constraint($constraint);
-        my $child      = _build_type_constraint($param);
+        my $parent;
+        if ($constraint eq 'Maybe') {
+            $parent = _build_type_constraint('Undef');
+        } else {
+            $parent = _build_type_constraint($constraint);
+        }
+        my $child = _build_type_constraint($param);
         if ($constraint eq 'ArrayRef') {
             my $code_str = 
                 "sub {\n" .
@@ -229,6 +234,13 @@ sub _build_type_constraint {
                 "};\n"
             ;
             $code = eval $code_str or Carp::confess($@);
+        } elsif ($constraint eq 'Maybe') {
+            my $code_str =
+                "sub {\n" .
+                "    return \$child->(\$_) || \$parent->(\$_);\n" .
+                "};\n"
+            ;
+            $code = eval $code_str or Carp::confess($@);
         } else {
             Carp::confess("Support for parameterized types other than ArrayRef or HashRef is not implemented yet");
         }
@@ -259,7 +271,9 @@ sub create {
         confess "Got isa => $args{isa}, but Mouse does not yet support parameterized types for containers other than ArrayRef and HashRef (rt.cpan.org #39795)"
             if $args{isa} =~ /^([^\[]+)\[.+\]$/ &&
                $1 ne 'ArrayRef' &&
-               $1 ne 'HashRef';
+               $1 ne 'HashRef'  &&
+               $1 ne 'Maybe'
+        ;
 
         my $type_constraint = delete $args{isa};
         $type_constraint =~ s/\s//g;
diff --git a/t/300_immutable/007_immutable_trigger_from_constructor.t b/t/300_immutable/007_immutable_trigger_from_constructor.t
index e8382f0..0ddcc5f 100644
--- a/t/300_immutable/007_immutable_trigger_from_constructor.t
+++ b/t/300_immutable/007_immutable_trigger_from_constructor.t
@@ -6,7 +6,6 @@ use warnings;
 use Test::More;
 use Test::Exception;
 
-plan skip_all => "mouse doesn't support Maybe[] yet";
 plan tests => 3;
 
 {