All non-parameterized types now have inlining code
[gitmo/Moose.git] / lib / Moose / Util / TypeConstraints.pm
index ac3b7b1..59d635c 100644 (file)
@@ -6,10 +6,6 @@ use List::MoreUtils qw( all any );
 use Scalar::Util qw( blessed reftype );
 use Moose::Exporter;
 
-our $VERSION = '0.83';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
 ## --------------------------------------------------------
 # Prototyped subs must be predeclared because we have a
 # circular dependency with Moose::Meta::Attribute et. al.
@@ -22,9 +18,11 @@ sub where (&);
 sub via (&);
 sub message (&);
 sub optimize_as (&);
+sub inline_as (&);
 
 ## --------------------------------------------------------
 
+use Moose::Deprecated;
 use Moose::Meta::TypeConstraint;
 use Moose::Meta::TypeConstraint::Union;
 use Moose::Meta::TypeConstraint::Parameterized;
@@ -36,7 +34,6 @@ use Moose::Meta::TypeConstraint::DuckType;
 use Moose::Meta::TypeCoercion;
 use Moose::Meta::TypeCoercion::Union;
 use Moose::Meta::TypeConstraint::Registry;
-use Moose::Util::TypeConstraints::OptimizedConstraints;
 
 Moose::Exporter->setup_import_methods(
     as_is => [
@@ -46,9 +43,9 @@ Moose::Exporter->setup_import_methods(
             coerce from via
             enum
             find_type_constraint
-            register_type_constraint )
+            register_type_constraint
+            match_on_type )
     ],
-    _export_to_main => 1,
 );
 
 ## --------------------------------------------------------
@@ -275,6 +272,12 @@ sub type {
 
     # back-compat version, called without sugar
     if ( !any { ( reftype($_) || '' ) eq 'HASH' } @_ ) {
+        Moose::Deprecated::deprecated(
+            feature => 'type without sugar',
+            message =>
+                'Calling type() with a simple list of parameters is deprecated. This will be an error in Moose 2.0200.'
+        );
+
         return _create_type_constraint( $_[0], undef, $_[1] );
     }
 
@@ -284,7 +287,7 @@ sub type {
 
     return _create_type_constraint(
         $name, undef, $p{where}, $p{message},
-        $p{optimize_as}
+        $p{optimize_as}, $p{inline_as},
     );
 }
 
@@ -294,6 +297,12 @@ sub subtype {
     #
     # subtype 'Parent', sub { where };
     if ( scalar @_ == 2 && ( reftype( $_[1] ) || '' ) eq 'CODE' ) {
+        Moose::Deprecated::deprecated(
+            feature => 'subtype without sugar',
+            message =>
+                'Calling subtype() with a simple list of parameters is deprecated. This will be an error in Moose 2.0200.'
+        );
+
         return _create_type_constraint( undef, @_ );
     }
 
@@ -301,11 +310,23 @@ sub subtype {
     # subtype 'Parent', sub { where }, sub { message }, sub { optimized };
     if ( scalar @_ >= 3 && all { ( reftype($_) || '' ) eq 'CODE' }
         @_[ 1 .. $#_ ] ) {
+        Moose::Deprecated::deprecated(
+            feature => 'subtype without sugar',
+            message =>
+                'Calling subtype() with a simple list of parameters is deprecated. This will be an error in Moose 2.0200.'
+        );
+
         return _create_type_constraint( undef, @_ );
     }
 
     # subtype 'Name', 'Parent', ...
     if ( scalar @_ >= 2 && all { !ref } @_[ 0, 1 ] ) {
+        Moose::Deprecated::deprecated(
+            feature => 'subtype without sugar',
+            message =>
+                'Calling subtype() with a simple list of parameters is deprecated. This will be an error in Moose 2.0200.'
+        );
+
         return _create_type_constraint(@_);
     }
 
@@ -329,7 +350,7 @@ sub subtype {
 
     return _create_type_constraint(
         $name, $p{as}, $p{where}, $p{message},
-        $p{optimize_as}
+        $p{optimize_as}, $p{inline_as},
     );
 }
 
@@ -365,6 +386,9 @@ sub duck_type {
         @methods   = @$type_name;
         $type_name = undef;
     }
+    if ( @methods == 1 && ref $methods[0] eq 'ARRAY' ) {
+        @methods = @{ $methods[0] };
+    }
 
     register_type_constraint(
         create_duck_type_constraint(
@@ -390,12 +414,13 @@ sub coerce {
 #
 # subtype( 'Foo', as( 'Str', where { ... } ) );
 #
-# If as() returns all it's extra arguments, this just works, and
+# If as() returns all its extra arguments, this just works, and
 # preserves backwards compatibility.
 sub as { { as => shift }, @_ }
 sub where (&)       { { where       => $_[0] } }
 sub message (&)     { { message     => $_[0] } }
 sub optimize_as (&) { { optimize_as => $_[0] } }
+sub inline_as (&)   { { inline_as   => $_[0] } }
 
 sub from    {@_}
 sub via (&) { $_[0] }
@@ -407,14 +432,16 @@ sub enum {
     # if only an array-ref is passed then
     # you get an anon-enum
     # - SL
-    if ( ref $type_name eq 'ARRAY' && !@values ) {
+    if ( ref $type_name eq 'ARRAY' ) {
+        @values == 0
+            || __PACKAGE__->_throw_error("enum called with an array reference and additional arguments. Did you mean to parenthesize the enum call's parameters?");
+
         @values    = @$type_name;
         $type_name = undef;
     }
-    ( scalar @values >= 2 )
-        || __PACKAGE__->_throw_error(
-        "You must have at least two values to enumerate through");
-    my %valid = map { $_ => 1 } @values;
+    if ( @values == 1 && ref $values[0] eq 'ARRAY' ) {
+        @values = @{ $values[0] };
+    }
 
     register_type_constraint(
         create_enum_type_constraint(
@@ -442,6 +469,39 @@ sub create_duck_type_constraint {
     );
 }
 
+sub match_on_type {
+    my ($to_match, @cases) = @_;
+    my $default;
+    if (@cases % 2 != 0) {
+        $default = pop @cases;
+        (ref $default eq 'CODE')
+            || __PACKAGE__->_throw_error("Default case must be a CODE ref, not $default");
+    }
+    while (@cases) {
+        my ($type, $action) = splice @cases, 0, 2;
+
+        unless (blessed $type && $type->isa('Moose::Meta::TypeConstraint')) {
+            $type = find_or_parse_type_constraint($type)
+                 || __PACKAGE__->_throw_error("Cannot find or parse the type '$type'")
+        }
+
+        (ref $action eq 'CODE')
+            || __PACKAGE__->_throw_error("Match action must be a CODE ref, not $action");
+
+        if ($type->check($to_match)) {
+            local $_ = $to_match;
+            return $action->($to_match);
+        }
+    }
+    (defined $default)
+        || __PACKAGE__->_throw_error("No cases matched for $to_match");
+    {
+        local $_ = $to_match;
+        return $default->($to_match);
+    }
+}
+
+
 ## --------------------------------------------------------
 ## desugaring functions ...
 ## --------------------------------------------------------
@@ -452,6 +512,7 @@ sub _create_type_constraint ($$$;$$) {
     my $check     = shift;
     my $message   = shift;
     my $optimized = shift;
+    my $inlined   = shift;
 
     my $pkg_defined_in = scalar( caller(1) );
 
@@ -478,6 +539,7 @@ sub _create_type_constraint ($$$;$$) {
         ( $check     ? ( constraint => $check )     : () ),
         ( $message   ? ( message    => $message )   : () ),
         ( $optimized ? ( optimized  => $optimized ) : () ),
+        ( $inlined   ? ( inlined    => $inlined )   : () ),
     );
 
     my $constraint;
@@ -533,20 +595,54 @@ sub _install_type_coercions ($$) {
     use re "eval";
 
     my $valid_chars = qr{[\w:\.]};
-    my $type_atom   = qr{ $valid_chars+ };
-
-    my $any;
-
-    my $type = qr{  $valid_chars+  (?: \[ \s* (??{$any})   \s* \] )? }x;
-    my $type_capture_parts
-        = qr{ ($valid_chars+) (?: \[ \s* ((??{$any})) \s* \] )? }x;
-    my $type_with_parameter
-        = qr{  $valid_chars+      \[ \s* (??{$any})   \s* \]    }x;
-
-    my $op_union = qr{ \s* \| \s* }x;
-    my $union    = qr{ $type (?: $op_union $type )+ }x;
+    my $type_atom   = qr{ (?>$valid_chars+) }x;
+    my $ws          = qr{ (?>\s*) }x;
+    my $op_union    = qr{ $ws \| $ws }x;
+
+    my ($type, $type_capture_parts, $type_with_parameter, $union, $any);
+    if (Class::MOP::IS_RUNNING_ON_5_10) {
+        my $type_pattern
+            = q{  (?&type_atom)  (?: \[ (?&ws)  (?&any)  (?&ws) \] )? };
+        my $type_capture_parts_pattern
+            = q{ ((?&type_atom)) (?: \[ (?&ws) ((?&any)) (?&ws) \] )? };
+        my $type_with_parameter_pattern
+            = q{  (?&type_atom)      \[ (?&ws)  (?&any)  (?&ws) \]    };
+        my $union_pattern
+            = q{ (?&type) (?> (?: (?&op_union) (?&type) )+ ) };
+        my $any_pattern
+            = q{ (?&type) | (?&union) };
+
+        my $defines = qr{(?(DEFINE)
+            (?<valid_chars>         $valid_chars)
+            (?<type_atom>           $type_atom)
+            (?<ws>                  $ws)
+            (?<op_union>            $op_union)
+            (?<type>                $type_pattern)
+            (?<type_capture_parts>  $type_capture_parts_pattern)
+            (?<type_with_parameter> $type_with_parameter_pattern)
+            (?<union>               $union_pattern)
+            (?<any>                 $any_pattern)
+        )}x;
+
+        $type                = qr{ $type_pattern                $defines }x;
+        $type_capture_parts  = qr{ $type_capture_parts_pattern  $defines }x;
+        $type_with_parameter = qr{ $type_with_parameter_pattern $defines }x;
+        $union               = qr{ $union_pattern               $defines }x;
+        $any                 = qr{ $any_pattern                 $defines }x;
+    }
+    else {
+        $type
+            = qr{  $type_atom  (?: \[ $ws  (??{$any})  $ws \] )? }x;
+        $type_capture_parts
+            = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x;
+        $type_with_parameter
+            = qr{  $type_atom      \[ $ws  (??{$any})  $ws \]    }x;
+        $union
+            = qr{ $type (?> (?: $op_union $type )+ ) }x;
+        $any
+            = qr{ $type | $union }x;
+    }
 
-    $any = qr{ $type | $union }x;
 
     sub _parse_parameterized_type_constraint {
         { no warnings 'void'; $any; }  # force capture of interpolated lexical
@@ -585,8 +681,9 @@ sub _install_type_coercions ($$) {
 # define some basic built-in types
 ## --------------------------------------------------------
 
-# By making these classes immutable before creating all the types we
-# below, we avoid repeatedly calling the slow MOP-based accessors.
+# By making these classes immutable before creating all the types in
+# Moose::Util::TypeConstraints::Builtin , we avoid repeatedly calling the slow
+# MOP-based accessors.
 $_->make_immutable(
     inline_constructor => 1,
     constructor_name   => "_new",
@@ -607,134 +704,11 @@ $_->make_immutable(
     Moose::Meta::TypeConstraint::Registry
 );
 
-type 'Any'  => where {1};    # meta-type including all
-subtype 'Item' => as 'Any';  # base-type
-
-subtype 'Undef'   => as 'Item' => where { !defined($_) };
-subtype 'Defined' => as 'Item' => where { defined($_) };
-
-subtype 'Bool' => as 'Item' =>
-    where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
-
-subtype 'Value' => as 'Defined' => where { !ref($_) } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value;
-
-subtype 'Ref' => as 'Defined' => where { ref($_) } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref;
-
-subtype 'Str' => as 'Value' => where {1} =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
-
-subtype 'Num' => as 'Str' =>
-    where { Scalar::Util::looks_like_number($_) } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num;
-
-subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int;
-
-subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' } =>
-    optimize_as
-    \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef;
-subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef;
-subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } =>
-    optimize_as
-    \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef;
-subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef;
-
-# NOTE:
-# scalar filehandles are GLOB refs,
-# but a GLOB ref is not always a filehandle
-subtype 'FileHandle' => as 'GlobRef' => where {
-    Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") );
-} => optimize_as
-    \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle;
-
-# NOTE:
-# blessed(qr/.../) returns true,.. how odd
-subtype 'Object' => as 'Ref' =>
-    where { blessed($_) && blessed($_) ne 'Regexp' } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object;
-
-subtype 'Role' => as 'Object' => where { $_->can('does') } =>
-    optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
-
-my $_class_name_checker = sub { };
-
-subtype 'ClassName' => as 'Str' =>
-    where { Class::MOP::is_class_loaded($_) } => optimize_as
-    \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
-
-subtype 'RoleName' => as 'ClassName' => where {
-    (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
-} => optimize_as
-    \&Moose::Util::TypeConstraints::OptimizedConstraints::RoleName;
-
-## --------------------------------------------------------
-# parameterizable types ...
-
-$REGISTRY->add_type_constraint(
-    Moose::Meta::TypeConstraint::Parameterizable->new(
-        name               => 'ArrayRef',
-        package_defined_in => __PACKAGE__,
-        parent             => find_type_constraint('Ref'),
-        constraint         => sub { ref($_) eq 'ARRAY' },
-        optimized =>
-            \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef,
-        constraint_generator => sub {
-            my $type_parameter = shift;
-            my $check          = $type_parameter->_compiled_type_constraint;
-            return sub {
-                foreach my $x (@$_) {
-                    ( $check->($x) ) || return;
-                }
-                1;
-                }
-        }
-    )
-);
-
-$REGISTRY->add_type_constraint(
-    Moose::Meta::TypeConstraint::Parameterizable->new(
-        name               => 'HashRef',
-        package_defined_in => __PACKAGE__,
-        parent             => find_type_constraint('Ref'),
-        constraint         => sub { ref($_) eq 'HASH' },
-        optimized =>
-            \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef,
-        constraint_generator => sub {
-            my $type_parameter = shift;
-            my $check          = $type_parameter->_compiled_type_constraint;
-            return sub {
-                foreach my $x ( values %$_ ) {
-                    ( $check->($x) ) || return;
-                }
-                1;
-                }
-        }
-    )
-);
-
-$REGISTRY->add_type_constraint(
-    Moose::Meta::TypeConstraint::Parameterizable->new(
-        name                 => 'Maybe',
-        package_defined_in   => __PACKAGE__,
-        parent               => find_type_constraint('Item'),
-        constraint           => sub {1},
-        constraint_generator => sub {
-            my $type_parameter = shift;
-            my $check          = $type_parameter->_compiled_type_constraint;
-            return sub {
-                return 1 if not( defined($_) ) || $check->($_);
-                return;
-                }
-        }
-    )
-);
+require Moose::Util::TypeConstraints::Builtins;
+Moose::Util::TypeConstraints::Builtins::define_builtins($REGISTRY);
 
 my @PARAMETERIZABLE_TYPES
-    = map { $REGISTRY->get_type_constraint($_) } qw[ArrayRef HashRef Maybe];
+    = map { $REGISTRY->get_type_constraint($_) } qw[ScalarRef ArrayRef HashRef Maybe];
 
 sub get_all_parameterizable_types {@PARAMETERIZABLE_TYPES}
 
@@ -766,32 +740,30 @@ sub _throw_error {
 
 1;
 
+# ABSTRACT: Type constraint system for Moose
+
 __END__
 
 =pod
 
-=head1 NAME
-
-Moose::Util::TypeConstraints - Type constraint system for Moose
-
 =head1 SYNOPSIS
 
   use Moose::Util::TypeConstraints;
 
-  subtype 'Natural'
-      => as 'Int'
-      => where { $_ > 0 };
+  subtype 'Natural',
+      as 'Int',
+      where { $_ > 0 };
 
-  subtype 'NaturalLessThanTen'
-      => as 'Natural'
-      => where { $_ < 10 }
-      => message { "This number ($_) is not less than ten!" };
+  subtype 'NaturalLessThanTen',
+      as 'Natural',
+      where { $_ < 10 },
+      message { "This number ($_) is not less than ten!" };
 
-  coerce 'Num'
-      => from 'Str'
-        => via { 0+$_ };
+  coerce 'Num',
+      from 'Str',
+      via { 0+$_ };
 
-  enum 'RGBColors' => qw(red green blue);
+  enum 'RGBColors', [qw(red green blue)];
 
   no Moose::Util::TypeConstraints;
 
@@ -833,7 +805,7 @@ this, as well as future proof your subtypes from classes which have
 yet to have been created, is to quote the type name:
 
   use DateTime;
-  subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
+  subtype 'DateTime', as 'Object', where { $_->isa('DateTime') };
 
 =head2 Default Type Constraints
 
@@ -847,13 +819,13 @@ that hierarchy represented visually.
       Undef
       Defined
           Value
-              Num
-                  Int
               Str
+                  Num
+                      Int
                   ClassName
                   RoleName
           Ref
-              ScalarRef
+              ScalarRef[`a]
               ArrayRef[`a]
               HashRef[`a]
               CodeRef
@@ -861,13 +833,13 @@ that hierarchy represented visually.
               GlobRef
                   FileHandle
               Object
-                  Role
 
 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
 parameterized, this means you can say:
 
   ArrayRef[Int]    # an array of integers
   HashRef[CodeRef] # a hash of str to CODE ref mappings
+  ScalarRef[Int]   # a reference to an integer
   Maybe[Str]       # value may be a string, may be undefined
 
 If Moose finds a name in brackets that it does not recognize as an
@@ -887,8 +859,7 @@ existence check. This means that your class B<must> be loaded for this
 type constraint to pass.
 
 B<NOTE:> The C<RoleName> constraint checks a string is a I<package
-name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
-constraint checks that an I<object> has a C<does> method.
+name> which is a role, like C<'MyApp::Role::Comparable'>.
 
 =head2 Type Constraint Naming
 
@@ -905,7 +876,7 @@ I<My::Graphics::Types::Color> instead.
 
 This module can play nicely with other constraint modules with some
 slight tweaking. The C<where> clause in types is expected to be a
-C<CODE> reference which checks it's first argument and returns a
+C<CODE> reference which checks its first argument and returns a
 boolean. Since most constraint modules work in a similar way, it
 should be simple to adapt them to work with Moose.
 
@@ -913,21 +884,21 @@ For instance, this is how you could use it with
 L<Declare::Constraints::Simple> to declare a completely new type.
 
   type 'HashOfArrayOfObjects',
-      {
-      where => IsHashRef(
-          -keys   => HasLength,
-          -values => IsArrayRef(IsObject)
-      )
-  };
-
-For more examples see the F<t/200_examples/004_example_w_DCS.t> test
+      where {
+          IsHashRef(
+              -keys   => HasLength,
+              -values => IsArrayRef(IsObject)
+          )->(@_);
+      };
+
+For more examples see the F<t/examples/example_w_DCS.t> test
 file.
 
-Here is an example of using L<Test::Deep> and it's non-test
+Here is an example of using L<Test::Deep> and its non-test
 related C<eq_deeply> function.
 
-  type 'ArrayOfHashOfBarsAndRandomNumbers'
-      => where {
+  type 'ArrayOfHashOfBarsAndRandomNumbers',
+      where {
           eq_deeply($_,
               array_each(subhashof({
                   bar           => isa('Bar'),
@@ -936,7 +907,23 @@ related C<eq_deeply> function.
         };
 
 For a complete example see the
-F<t/200_examples/005_example_w_TestDeep.t> test file.
+F<t/examples/example_w_TestDeep.t> test file.
+
+=head2 Error messages
+
+Type constraints can also specify custom error messages, for when they fail to
+validate. This is provided as just another coderef, which receives the invalid
+value in C<$_>, as in:
+
+  subtype 'PositiveInt',
+       as 'Int',
+       where { $_ > 0 },
+       message { "$_ is not a positive integer!" };
+
+If no message is specified, a default message will be used, which indicates
+which type constraint was being used and what value failed. If
+L<Devel::PartialDump> (version 0.14 or higher) is installed, it will be used to
+display the invalid value, otherwise it will just be printed as is.
 
 =head1 FUNCTIONS
 
@@ -946,11 +933,11 @@ The following functions are used to create type constraints.  They
 will also register the type constraints your create in a global
 registry that is used to look types up by name.
 
-See the L<SYNOPSIS> for an example of how to use these.
+See the L</SYNOPSIS> for an example of how to use these.
 
 =over 4
 
-=item B<< subtype 'Name' => as 'Parent' => where { } ... >>
+=item B<< subtype 'Name', as 'Parent', where { } ... >>
 
 This creates a named subtype.
 
@@ -966,7 +953,7 @@ name and a hashref of parameters:
 The valid hashref keys are C<as> (the parent), C<where>, C<message>,
 and C<optimize_as>.
 
-=item B<< subtype as 'Parent' => where { } ... >>
+=item B<< subtype as 'Parent', where { } ... >>
 
 This creates an unnamed subtype and will return the type
 constraint meta-object, which will be an instance of
@@ -993,10 +980,10 @@ metaclass L<Moose::Meta::TypeConstraint::Role>.
 Creates a type constraint for either C<undef> or something of the
 given type.
 
-=item B<duck_type ($name, @methods)>
+=item B<duck_type ($name, \@methods)>
 
 This will create a subtype of Object and test to make sure the value
-C<can()> do the methods in C<@methods>.
+C<can()> do the methods in C<\@methods>.
 
 This is intended as an easy way to accept non-Moose objects that
 provide a certain interface. If you're using Moose classes, we
@@ -1004,30 +991,30 @@ recommend that you use a C<requires>-only Role instead.
 
 =item B<duck_type (\@methods)>
 
-If passed an ARRAY reference instead of the C<$name>, C<@methods>
-pair, this will create an unnamed duck type. This can be used in an
-attribute definition like so:
+If passed an ARRAY reference as the only parameter instead of the
+C<$name>, C<\@methods> pair, this will create an unnamed duck type.
+This can be used in an attribute definition like so:
 
   has 'cache' => (
       is  => 'ro',
       isa => duck_type( [qw( get_set )] ),
   );
 
-=item B<enum ($name, @values)>
+=item B<enum ($name, \@values)>
 
 This will create a basic subtype for a given set of strings.
 The resulting constraint will be a subtype of C<Str> and
-will match any of the items in C<@values>. It is case sensitive.
-See the L<SYNOPSIS> for a simple example.
+will match any of the items in C<\@values>. It is case sensitive.
+See the L</SYNOPSIS> for a simple example.
 
 B<NOTE:> This is not a true proper enum type, it is simply
 a convenient constraint builder.
 
 =item B<enum (\@values)>
 
-If passed an ARRAY reference instead of the C<$name>, C<@values> pair,
-this will create an unnamed enum. This can then be used in an attribute
-definition like so:
+If passed an ARRAY reference as the only parameter instead of the
+C<$name>, C<\@values> pair, this will create an unnamed enum. This
+can then be used in an attribute definition like so:
 
   has 'sort_order' => (
       is  => 'ro',
@@ -1064,11 +1051,11 @@ This can be used to define a "hand optimized" version of your
 type constraint which can be used to avoid traversing a subtype
 constraint hierarchy.
 
-B<NOTE:> You should only use this if you know what you are doing,
-all the built in types use this, so your subtypes (assuming they
+B<NOTE:> You should only use this if you know what you are doing.
+All the built in types use this, so your subtypes (assuming they
 are shallow) will not likely need to use this.
 
-=item B<type 'Name' => where { } ... >
+=item B<< type 'Name', where { } ... >>
 
 This creates a base type, which has no parent.
 
@@ -1082,6 +1069,78 @@ The valid hashref keys are C<where>, C<message>, and C<optimize_as>.
 
 =back
 
+=head2 Type Constraint Utilities
+
+=over 4
+
+=item B<< match_on_type $value => ( $type => \&action, ... ?\&default ) >>
+
+This is a utility function for doing simple type based dispatching similar to
+match/case in OCaml and case/of in Haskell. It is not as featureful as those
+languages, nor does not it support any kind of automatic destructuring
+bind. Here is a simple Perl pretty printer dispatching over the core Moose
+types.
+
+  sub ppprint {
+      my $x = shift;
+      match_on_type $x => (
+          HashRef => sub {
+              my $hash = shift;
+              '{ '
+                  . (
+                  join ", " => map { $_ . ' => ' . ppprint( $hash->{$_} ) }
+                      sort keys %$hash
+                  ) . ' }';
+          },
+          ArrayRef => sub {
+              my $array = shift;
+              '[ ' . ( join ", " => map { ppprint($_) } @$array ) . ' ]';
+          },
+          CodeRef   => sub {'sub { ... }'},
+          RegexpRef => sub { 'qr/' . $_ . '/' },
+          GlobRef   => sub { '*' . B::svref_2object($_)->NAME },
+          Object    => sub { $_->can('to_string') ? $_->to_string : $_ },
+          ScalarRef => sub { '\\' . ppprint( ${$_} ) },
+          Num       => sub {$_},
+          Str       => sub { '"' . $_ . '"' },
+          Undef     => sub {'undef'},
+          => sub { die "I don't know what $_ is" }
+      );
+  }
+
+Or a simple JSON serializer:
+
+  sub to_json {
+      my $x = shift;
+      match_on_type $x => (
+          HashRef => sub {
+              my $hash = shift;
+              '{ '
+                  . (
+                  join ", " =>
+                      map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) }
+                      sort keys %$hash
+                  ) . ' }';
+          },
+          ArrayRef => sub {
+              my $array = shift;
+              '[ ' . ( join ", " => map { to_json($_) } @$array ) . ' ]';
+          },
+          Num   => sub {$_},
+          Str   => sub { '"' . $_ . '"' },
+          Undef => sub {'null'},
+          => sub { die "$_ is not acceptable json type" }
+      );
+  }
+
+The matcher is done by mapping a C<$type> to an C<\&action>. The C<$type> can
+be either a string type or a L<Moose::Meta::TypeConstraint> object, and
+C<\&action> is a subroutine reference. This function will dispatch on the
+first match for C<$value>. It is possible to have a catch-all by providing an
+additional subroutine reference as the final argument to C<match_on_type>.
+
+=back
+
 =head2 Type Coercion Constructors
 
 You can define coercions for type constraints, which allow you to
@@ -1091,15 +1150,21 @@ the type-coercion code first, followed by the type constraint
 check. This feature should be used carefully as it is very powerful
 and could easily take off a limb if you are not careful.
 
-See the L<SYNOPSIS> for an example of how to use these.
+See the L</SYNOPSIS> for an example of how to use these.
 
 =over 4
 
-=item B<< coerce 'Name' => from 'OtherName' => via { ... } >>
+=item B<< coerce 'Name', from 'OtherName', via { ... }  >>
 
 This defines a coercion from one type to another. The C<Name> argument
 is the type you are coercing I<to>.
 
+To define multiple coercions, supply more sets of from/via pairs:
+
+  coerce 'Name',
+    from 'OtherName', via { ... },
+    from 'ThirdName', via { ... };
+
 =item B<from 'OtherName'>
 
 This is just sugar for the type coercion construction syntax.
@@ -1203,7 +1268,7 @@ global registry.
 =item B<find_or_create_does_type_constraint($type_name)>
 
 These functions will first call C<find_or_parse_type_constraint>. If
-that function does not return a type, a new anonymous type object will
+that function does not return a type, a new type object will
 be created.
 
 The C<isa> variant will use C<create_class_type_constraint> and the
@@ -1245,21 +1310,6 @@ Adds C<$type> to the list of parameterizable types
 
 =head1 BUGS
 
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
-
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2009 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+See L<Moose/BUGS> for details on reporting bugs.
 
 =cut