From: Shawn M Moore <sartak@gmail.com>
Date: Mon, 22 Dec 2008 02:36:38 +0000 (+0000)
Subject: "type" sugar for when you're not subtyping anything
X-Git-Tag: 0.19~97
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0d9fea2202e3abf87e59f693afab640548faeef5;p=gitmo%2FMouse.git

"type" sugar for when you're not subtyping anything
---

diff --git a/Changes b/Changes
index 1816af2..5501709 100644
--- a/Changes
+++ b/Changes
@@ -5,6 +5,8 @@ Revision history for Mouse
 
     * Rename Mouse::TypeRegistry to Mouse::Util::TypeConstraints
 
+    * "type" sugar for when you're not subtyping anything
+
 0.14 Sat Dec 20 16:53:05 2008
     * POD fix
 
diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index 812ecd6..623bd83 100644
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -21,6 +21,7 @@ sub import {
     *{"$caller\::message"}     = \&_message;
     *{"$caller\::from"}        = \&_from;
     *{"$caller\::via"}         = \&_via;
+    *{"$caller\::type"}        = \&_type;
     *{"$caller\::subtype"}     = \&_subtype;
     *{"$caller\::coerce"}      = \&_coerce;
     *{"$caller\::class_type"}  = \&_class_type;
@@ -85,6 +86,16 @@ my $optimized_constraints_base;
     sub list_all_builtin_type_constraints { @SUBTYPE_KEYS }
 }
 
+sub _type {
+    my $pkg = caller(0);
+    my($name, %conf) = @_;
+    if (my $type = $SUBTYPE{$name}) {
+        Carp::croak "The type constraint '$name' has already been created, cannot be created again in $pkg";
+    };
+    my $stuff = $conf{where} || do { $SUBTYPE{delete $conf{as} || 'Any' } };
+    $SUBTYPE{$name} = $stuff;
+}
+
 sub _subtype {
     my $pkg = caller(0);
     my($name, %conf) = @_;
diff --git a/t/501_moose_coerce_mouse.t b/t/501_moose_coerce_mouse.t
index 486e118..9633b0e 100644
--- a/t/501_moose_coerce_mouse.t
+++ b/t/501_moose_coerce_mouse.t
@@ -22,7 +22,7 @@ use Test::Exception;
     use Mouse;
     use Mouse::Util::TypeConstraints;
 
-    subtype 'HeadersType' => where { defined $_ && eval { $_->isa('Headers') } };
+    type 'HeadersType' => where { defined $_ && eval { $_->isa('Headers') } };
     coerce  'HeadersType' =>
         from 'HashRef' => via {
             Headers->new(%{ $_ });