From: Adam J. Foxson <fhoxh@pobox.com>
Date: Mon, 16 Feb 2009 03:22:47 +0000 (+0000)
Subject: Simplistic implementation of type intersections, modeled after the implementation... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8aab053afb75771a22366fb0a15a55699600f956;p=gitmo%2FMoose.git

Simplistic implementation of type intersections, modeled after the implementation of type unions.
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index f776e12..4884e03 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -231,6 +231,7 @@ $_->make_immutable(
 
     Moose::Meta::TypeCoercion
     Moose::Meta::TypeCoercion::Union
+    Moose::Meta::TypeCoercion::Intersection
 
     Moose::Meta::Method
     Moose::Meta::Method::Constructor
diff --git a/lib/Moose/Meta/TypeCoercion/Intersection.pm b/lib/Moose/Meta/TypeCoercion/Intersection.pm
new file mode 100644
index 0000000..a297fc0
--- /dev/null
+++ b/lib/Moose/Meta/TypeCoercion/Intersection.pm
@@ -0,0 +1,104 @@
+
+package Moose::Meta::TypeCoercion::Intersection;
+
+use strict;
+use warnings;
+use metaclass;
+
+use Scalar::Util 'blessed';
+
+our $VERSION   = '0.70';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::TypeCoercion';
+
+sub compile_type_coercion {
+    my $self            = shift;
+    my $type_constraint = $self->type_constraint;
+    
+    (blessed $type_constraint && $type_constraint->isa('Moose::Meta::TypeConstraint::Intersection'))
+     || Moose->throw_error("You can only a Moose::Meta::TypeCoercion::Intersection for a " .
+                "Moose::Meta::TypeConstraint::Intersection, not a $type_constraint");
+    
+    $self->_compiled_type_coercion(sub {
+        my $value = shift;
+        # go through all the type constraints 
+        # in the intersection, and check em ...
+        foreach my $type (@{$type_constraint->type_constraints}) {
+            # if they have a coercion first
+            if ($type->has_coercion) {    
+                # then try to coerce them ...
+                my $temp = $type->coerce($value);
+                # and if they get something 
+                # make sure it still fits within
+                # the intersection type ...
+                return $temp if $type_constraint->check($temp);
+            }
+        }
+        return undef;    
+    });
+}
+
+sub has_coercion_for_type { 0 }
+
+sub add_type_coercions {
+    Moose->throw_error("Cannot add additional type coercions to Intersection types");
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Meta::TypeCoercion::Intersection - The Moose Type Coercion metaclass for intersections
+
+=head1 DESCRIPTION
+
+For the most part, the only time you will ever encounter an 
+instance of this class is if you are doing some serious deep 
+introspection. This API should not be considered final, but 
+it is B<highly unlikely> that this will matter to a regular 
+Moose user.
+
+If you wish to use features at this depth, please come to the 
+#moose IRC channel on irc.perl.org and we can talk :)
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<compile_type_coercion>
+
+=item B<has_coercion_for_type>
+
+=item B<add_type_coercions>
+
+=back
+
+=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> and
+Adam Foxson E<lt>afoxson@pobox.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. 
+
+=cut
diff --git a/lib/Moose/Meta/TypeConstraint/Intersection.pm b/lib/Moose/Meta/TypeConstraint/Intersection.pm
new file mode 100644
index 0000000..8e71c69
--- /dev/null
+++ b/lib/Moose/Meta/TypeConstraint/Intersection.pm
@@ -0,0 +1,233 @@
+
+package Moose::Meta::TypeConstraint::Intersection;
+
+use strict;
+use warnings;
+use metaclass;
+
+use Moose::Meta::TypeCoercion::Intersection;
+
+our $VERSION   = '0.70';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::TypeConstraint';
+
+__PACKAGE__->meta->add_attribute('type_constraints' => (
+    accessor  => 'type_constraints',
+    default   => sub { [] }
+));
+
+sub new { 
+    my ($class, %options) = @_;
+    my $self = $class->SUPER::new(
+        name     => (join '&' => sort {$a cmp $b}
+                     map { $_->name } @{$options{type_constraints}}),
+        parent   => undef,
+        message  => undef,
+        hand_optimized_type_constraint => undef,
+        compiled_type_constraint => sub {
+            my $value = shift;
+            my $count = 0;
+            foreach my $type (@{$options{type_constraints}}) {
+                $count++ if $type->check($value);
+            }
+            return $count == scalar @{$options{type_constraints}} ? 1 : undef;
+        },
+        %options
+    );
+    $self->_set_constraint(sub { $self->check($_[0]) });
+    $self->coercion(Moose::Meta::TypeCoercion::Intersection->new(
+        type_constraint => $self
+    ));
+    return $self;
+}
+
+sub equals {
+    my ( $self, $type_or_name ) = @_;
+
+    my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
+
+    return unless $other->isa(__PACKAGE__);
+
+    my @self_constraints  = @{ $self->type_constraints };
+    my @other_constraints = @{ $other->type_constraints };
+
+    return unless @self_constraints == @other_constraints;
+
+    # FIXME presort type constraints for efficiency?
+    constraint: foreach my $constraint ( @self_constraints ) {
+        for ( my $i = 0; $i < @other_constraints; $i++ ) {
+            if ( $constraint->equals($other_constraints[$i]) ) {
+                splice @other_constraints, $i, 1;
+                next constraint;
+            }
+        }
+    }
+
+    return @other_constraints == 0;
+}
+
+sub parents {
+    my $self = shift;
+    $self->type_constraints;
+}
+
+sub validate {
+    my ($self, $value) = @_;
+    my $message;
+    foreach my $type (@{$self->type_constraints}) {
+        my $err = $type->validate($value);
+        return unless defined $err;
+        $message .= ($message ? ' and ' : '') . $err
+            if defined $err;
+    }
+    return ($message . ' in (' . $self->name . ')') ;    
+}
+
+sub is_a_type_of {
+    my ($self, $type_name) = @_;
+    foreach my $type (@{$self->type_constraints}) {
+        return 1 if $type->is_a_type_of($type_name);
+    }
+    return 0;    
+}
+
+sub is_subtype_of {
+    my ($self, $type_name) = @_;
+    foreach my $type (@{$self->type_constraints}) {
+        return 1 if $type->is_subtype_of($type_name);
+    }
+    return 0;
+}
+
+sub create_child_type {
+    my ( $self, %opts ) = @_;
+
+    my $constraint
+        = Moose::Meta::TypeConstraint->new( %opts, parent => $self );
+
+    # if we have a type constraint intersection, and no
+    # type check, this means we are just aliasing
+    # the intersection constraint, which means we need to
+    # handle this differently.
+    # - SL
+    if ( not( defined $opts{constraint} )
+        && $self->has_coercion ) {
+        $constraint->coercion(
+            Moose::Meta::TypeCoercion::Intersection->new(
+                type_constraint => $self,
+            )
+        );
+    }
+
+    return $constraint;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Meta::TypeConstraint::Intersection - An intersection of Moose type constraints
+
+=head1 DESCRIPTION
+
+This metaclass represents an intersection of Moose type constraints. More 
+details to be explained later (possibly in a Cookbook recipe).
+
+This actually used to be part of Moose::Meta::TypeConstraint, but it 
+is now better off in it's own file. 
+
+=head1 METHODS
+
+This class is not a subclass of Moose::Meta::TypeConstraint, 
+but it does provide the same API
+
+=over 4
+
+=item B<meta>
+
+=item B<new>
+
+=item B<name>
+
+=item B<type_constraints>
+
+=item B<parents>
+
+=item B<constraint>
+
+=item B<includes_type>
+
+=item B<equals>
+
+=back
+
+=head2 Overridden methods 
+
+=over 4
+
+=item B<check>
+
+=item B<coerce>
+
+=item B<validate>
+
+=item B<is_a_type_of>
+
+=item B<is_subtype_of>
+
+=back
+
+=head2 Empty or Stub methods
+
+These methods tend to not be very relevant in 
+the context of an intersection. Either that or they are 
+just difficult to specify and not very useful 
+anyway. They are here for completeness.
+
+=over 4
+
+=item B<parent>
+
+=item B<coercion>
+
+=item B<has_coercion>
+
+=item B<message>
+
+=item B<has_message>
+
+=item B<hand_optimized_type_constraint>
+
+=item B<has_hand_optimized_type_constraint>
+
+=item B<create_child_type>
+
+=back
+
+=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> and
+Adam Foxson E<lt>afoxson@pobox.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.
+
+=cut
diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 43c5911..8fb9c64 100644
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -25,6 +25,7 @@ sub inline_as (&);
 use Moose::Deprecated;
 use Moose::Meta::TypeConstraint;
 use Moose::Meta::TypeConstraint::Union;
+use Moose::Meta::TypeConstraint::Intersection;
 use Moose::Meta::TypeConstraint::Parameterized;
 use Moose::Meta::TypeConstraint::Parameterizable;
 use Moose::Meta::TypeConstraint::Class;
@@ -33,6 +34,7 @@ use Moose::Meta::TypeConstraint::Enum;
 use Moose::Meta::TypeConstraint::DuckType;
 use Moose::Meta::TypeCoercion;
 use Moose::Meta::TypeCoercion::Union;
+use Moose::Meta::TypeCoercion::Intersection;
 use Moose::Meta::TypeConstraint::Registry;
 
 Moose::Exporter->setup_import_methods(
@@ -109,6 +111,28 @@ sub _create_type_constraint_union {
     return Moose::Meta::TypeConstraint::Union->new(%options);
 }
 
+sub create_type_constraint_intersection {
+    my @type_constraint_names;
+
+    if (scalar @_ == 1 && _detect_type_constraint_intersection($_[0])) {
+        @type_constraint_names = _parse_type_constraint_intersection($_[0]);
+    }
+    else {
+        @type_constraint_names = @_;
+    }
+    
+    (scalar @type_constraint_names >= 2)
+        || __PACKAGE__->_throw_error("You must pass in at least 2 type names to make an intersection");
+
+    my @type_constraints = map {
+        find_or_parse_type_constraint($_) ||
+         __PACKAGE__->_throw_error("Could not locate type constraint ($_) for the intersection");
+    } @type_constraint_names;
+
+    return Moose::Meta::TypeConstraint::Intersection->new(
+        type_constraints => \@type_constraints
+    );
+}
 
 sub create_parameterized_type_constraint {
     my $type_constraint_name = shift;
@@ -232,7 +256,10 @@ sub find_or_parse_type_constraint {
     if ( $constraint = find_type_constraint($type_constraint_name) ) {
         return $constraint;
     }
-    elsif ( _detect_type_constraint_union($type_constraint_name) ) {
+    elsif (_detect_type_constraint_intersection($type_constraint_name)) {
+        $constraint = create_type_constraint_intersection($type_constraint_name);
+    }
+    elsif (_detect_type_constraint_union($type_constraint_name)) {
         $constraint = create_type_constraint_union($type_constraint_name);
     }
     elsif ( _detect_parameterized_type_constraint($type_constraint_name) ) {
@@ -585,8 +612,9 @@ sub _install_type_coercions ($$) {
     my $type_atom   = qr{ (?>$valid_chars+) }x;
     my $ws          = qr{ (?>\s*) }x;
     my $op_union    = qr{ $ws \| $ws }x;
+    my $op_intersection = qr{ $ws & $ws }x;
 
-    my ($type, $type_capture_parts, $type_with_parameter, $union, $any);
+    my ($type, $type_capture_parts, $type_with_parameter, $union, $any, $intersection);
     if (Class::MOP::IS_RUNNING_ON_5_10) {
         my $type_pattern
             = q{  (?&type_atom)  (?: \[ (?&ws)  (?&any)  (?&ws) \] )? };
@@ -596,18 +624,22 @@ sub _install_type_coercions ($$) {
             = q{  (?&type_atom)      \[ (?&ws)  (?&any)  (?&ws) \]    };
         my $union_pattern
             = q{ (?&type) (?> (?: (?&op_union) (?&type) )+ ) };
+        my $intersection_pattern
+            = q{ (?&type) (?> (?: (?&op_intersection) (?&type) )+ ) };
         my $any_pattern
-            = q{ (?&type) | (?&union) };
+            = q{ (?&type) | (?&union) | (?&intersection) };
 
         my $defines = qr{(?(DEFINE)
             (?<valid_chars>         $valid_chars)
             (?<type_atom>           $type_atom)
             (?<ws>                  $ws)
             (?<op_union>            $op_union)
+            (?<op_intersection>     $op_intersection)
             (?<type>                $type_pattern)
             (?<type_capture_parts>  $type_capture_parts_pattern)
             (?<type_with_parameter> $type_with_parameter_pattern)
             (?<union>               $union_pattern)
+            (?<intersection>        $intersection_pattern)
             (?<any>                 $any_pattern)
         )}x;
 
@@ -615,6 +647,7 @@ sub _install_type_coercions ($$) {
         $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;
+        $intersection        = qr{ $intersection_pattern        $defines }x;
         $any                 = qr{ $any_pattern                 $defines }x;
     }
     else {
@@ -626,8 +659,10 @@ sub _install_type_coercions ($$) {
             = qr{  $type_atom      \[ $ws  (??{$any})  $ws \]    }x;
         $union
             = qr{ $type (?> (?: $op_union $type )+ ) }x;
+        $intersection
+            = qr{ $type (?> (?: $op_intersection $type )+ ) }x;
         $any
-            = qr{ $type | $union }x;
+            = qr{ $type | $union | $intersection }x;
     }
 
 
@@ -658,10 +693,31 @@ sub _install_type_coercions ($$) {
         @rv;
     }
 
+    sub _parse_type_constraint_intersection {
+        { no warnings 'void'; $any; } # force capture of interpolated lexical
+        my $given = shift;
+        my @rv;
+        while ( $given =~ m{ \G (?: $op_intersection )? ($type) }gcx ) {
+            push @rv => $1;
+        }
+        (pos($given) eq length($given))
+            || __PACKAGE__->_throw_error("'$given' didn't parse (parse-pos="
+                     . pos($given)
+                     . " and str-length="
+                     . length($given)
+                     . ")");
+        @rv;
+    }
+
     sub _detect_type_constraint_union {
         { no warnings 'void'; $any; }  # force capture of interpolated lexical
         $_[0] =~ m{^ $type $op_union $type ( $op_union .* )? $}x;
     }
+
+    sub _detect_type_constraint_intersection {
+        { no warnings 'void'; $any; } # force capture of interpolated lexical
+        $_[0] =~ m{^ $type $op_intersection $type ( $op_intersection .* )? $}x;
+    }
 }
 
 ## --------------------------------------------------------
@@ -682,6 +738,7 @@ $_->make_immutable(
     qw(
     Moose::Meta::TypeConstraint
     Moose::Meta::TypeConstraint::Union
+    Moose::Meta::TypeConstraint::Intersection
     Moose::Meta::TypeConstraint::Parameterized
     Moose::Meta::TypeConstraint::Parameterizable
     Moose::Meta::TypeConstraint::Class
@@ -1263,6 +1320,11 @@ This can take a union type specification like C<'Int|ArrayRef[Int]'>,
 or a list of names. It returns a new
 L<Moose::Meta::TypeConstraint::Union> object.
 
+=item B<create_type_constraint_intersection ($pipe_separated_types | @type_constraint_names)>
+
+Given string with C<$pipe_separated_types> or a list of C<@type_constraint_names>,
+this will return a L<Moose::Meta::TypeConstraint::Intersection> instance.
+
 =item B<create_parameterized_type_constraint($type_name)>
 
 Given a C<$type_name> in the form of C<'BaseType[ContainerType]'>,
diff --git a/t/040_type_constraints/034_intersection_types.t b/t/040_type_constraints/034_intersection_types.t
new file mode 100644
index 0000000..93a6a82
--- /dev/null
+++ b/t/040_type_constraints/034_intersection_types.t
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 34;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose::Util::TypeConstraints');           
+}
+
+my $Str = find_type_constraint('Str');
+isa_ok($Str, 'Moose::Meta::TypeConstraint');
+
+my $Defined = find_type_constraint('Defined');
+isa_ok($Defined, 'Moose::Meta::TypeConstraint');
+
+ok(!$Str->check(undef), '... Str cannot accept an Undef value');
+ok($Str->check('String'), '... Str can accept an String value');
+ok($Defined->check('String'), '... Defined can accept an Str value');
+ok(!$Defined->check(undef), '... Defined cannot accept an undef value');
+
+my $Str_and_Defined = Moose::Meta::TypeConstraint::Intersection->new(type_constraints => [$Str, $Defined]);
+isa_ok($Str_and_Defined, 'Moose::Meta::TypeConstraint::Intersection');
+
+ok($Str_and_Defined->check(''), '... (Str & Defined) can accept a Defined value');
+ok($Str_and_Defined->check('String'), '... (Str & Defined) can accept a String value');
+ok(!$Str_and_Defined->check([]), '... (Str & Defined) cannot accept an array reference');
+
+ok($Str_and_Defined->is_a_type_of($Str), "subtype of Str");
+ok($Str_and_Defined->is_a_type_of($Defined), "subtype of Defined");
+
+ok( !$Str_and_Defined->equals($Str), "not equal to Str" );
+ok( $Str_and_Defined->equals($Str_and_Defined), "equal to self" );
+ok( $Str_and_Defined->equals(Moose::Meta::TypeConstraint::Intersection->new(type_constraints => [ $Str, $Defined ])), "equal to clone" );
+ok( $Str_and_Defined->equals(Moose::Meta::TypeConstraint::Intersection->new(type_constraints => [ $Defined, $Str ])), "equal to reversed clone" );
+
+ok( !$Str_and_Defined->is_a_type_of("ThisTypeDoesNotExist"), "not type of non existant type" );
+ok( !$Str_and_Defined->is_subtype_of("ThisTypeDoesNotExist"), "not subtype of non existant type" );
+
+# another ....
+
+my $ArrayRef = find_type_constraint('ArrayRef');
+isa_ok($ArrayRef, 'Moose::Meta::TypeConstraint');
+
+my $Ref = find_type_constraint('Ref');
+isa_ok($Ref, 'Moose::Meta::TypeConstraint');
+
+ok($ArrayRef->check([]), '... ArrayRef can accept an [] value');
+ok(!$ArrayRef->check({}), '... ArrayRef cannot accept an {} value');
+ok($Ref->check({}), '... Ref can accept an {} value');
+ok(!$Ref->check(5), '... Ref cannot accept a 5 value');
+
+my $RefAndArray = Moose::Meta::TypeConstraint::Intersection->new(type_constraints => [$ArrayRef, $Ref]);
+isa_ok($RefAndArray, 'Moose::Meta::TypeConstraint::Intersection');
+
+ok($RefAndArray->check([]), '... (ArrayRef & Ref) can accept []');
+ok(!$RefAndArray->check({}), '... (ArrayRef & Ref) cannot accept {}');
+
+ok(!$RefAndArray->check(\(my $var1)), '... (ArrayRef & Ref) cannot accept scalar refs');
+ok(!$RefAndArray->check(sub {}), '... (ArrayRef & Ref) cannot accept code refs');
+ok(!$RefAndArray->check(50), '... (ArrayRef & Ref) cannot accept Numbers');
+
+diag $RefAndArray->validate([]);
+
+ok(!defined($RefAndArray->validate([])), '... (ArrayRef & Ref) can accept []');
+ok(defined($RefAndArray->validate(undef)), '... (ArrayRef & Ref) cannot accept undef');
+
+like($RefAndArray->validate(undef), 
+qr/Validation failed for \'ArrayRef\' failed with value undef and Validation failed for \'Ref\' failed with value undef in \(ArrayRef&Ref\)/, 
+'... (ArrayRef & Ref) cannot accept undef');
+
diff --git a/t/040_type_constraints/035_subtyping_intersection_types.t b/t/040_type_constraints/035_subtyping_intersection_types.t
new file mode 100644
index 0000000..c65856c
--- /dev/null
+++ b/t/040_type_constraints/035_subtyping_intersection_types.t
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 19;
+use Test::Exception;
+
+BEGIN {
+    use_ok("Moose::Util::TypeConstraints");
+}
+
+lives_ok {
+    subtype 'MyCollections' => as 'ArrayRef & Ref';
+} '... created the subtype special okay';
+
+{
+    my $t = find_type_constraint('MyCollections');
+    isa_ok($t, 'Moose::Meta::TypeConstraint');
+
+    is($t->name, 'MyCollections', '... name is correct');
+
+    my $p = $t->parent;
+    isa_ok($p, 'Moose::Meta::TypeConstraint::Intersection');
+    isa_ok($p, 'Moose::Meta::TypeConstraint');
+
+    is($p->name, 'ArrayRef&Ref', '... parent name is correct');
+
+    ok($t->check([]), '... validated it correctly');
+    ok(!$t->check(1), '... validated it correctly');
+}
+
+lives_ok {
+    subtype 'MyCollectionsExtended' 
+        => as 'ArrayRef&Ref'
+        => where {
+            if (ref($_) eq 'ARRAY') {
+                return if scalar(@$_) < 2;
+            }
+            1;
+        };
+} '... created the subtype special okay';
+
+{
+    my $t = find_type_constraint('MyCollectionsExtended');
+    isa_ok($t, 'Moose::Meta::TypeConstraint');
+
+    is($t->name, 'MyCollectionsExtended', '... name is correct');
+
+    my $p = $t->parent;
+    isa_ok($p, 'Moose::Meta::TypeConstraint::Intersection');
+    isa_ok($p, 'Moose::Meta::TypeConstraint');
+
+    is($p->name, 'ArrayRef&Ref', '... parent name is correct');
+
+    ok(!$t->check([]), '... validated it correctly');
+    ok($t->check([1, 2]), '... validated it correctly');    
+    
+    ok($t->check([ one => 1, two => 2 ]), '... validated it correctly');    
+    
+    ok(!$t->check(1), '... validated it correctly');
+}
+
+
diff --git a/t/type_constraints/advanced_type_creation.t b/t/type_constraints/advanced_type_creation.t
index 1350fdc..a21ac35 100644
--- a/t/type_constraints/advanced_type_creation.t
+++ b/t/type_constraints/advanced_type_creation.t
@@ -54,6 +54,17 @@ ok($pure_insanity->check([ 1, 'Str', 3 ]), '... this passed the type check');
 ok(!$pure_insanity->check([ 1, {}, 'foo' ]), '... this didnt pass the type check');
 ok(!$pure_insanity->check([ [], {}, 1 ]), '... this didnt pass the type check');
 
+# intersection of Arrays of Int | Str or Arrays of Str | Int
+
+my $sheer_insanity = Moose::Util::TypeConstraints::create_type_constraint_intersection('ArrayRef[Int|Str] & ArrayRef[Str | Int]');
+isa_ok($sheer_insanity, 'Moose::Meta::TypeConstraint::Intersection');
+
+ok($sheer_insanity->check([ 1, 4, 'foo' ]), '... this passed the type check');
+ok($sheer_insanity->check([ 1, 'Str', 'foo' ]), '... this passed the type check');
+
+ok(!$sheer_insanity->check([ 1, {}, 'foo' ]), '... this didnt pass the type check');
+ok(!$sheer_insanity->check([ [], {}, 1 ]), '... this didnt pass the type check');
+
 ## Nested Containers ...
 
 # Array of Ints
diff --git a/t/type_constraints/normalize_type_name.t b/t/type_constraints/normalize_type_name.t
index e6d7a5a..83eaa37 100644
--- a/t/type_constraints/normalize_type_name.t
+++ b/t/type_constraints/normalize_type_name.t
@@ -149,4 +149,19 @@ is $union1->name, $union3->name, 'names match';
 
 is $union2->name, $union3->name, 'names match';
 
-done_testing;
+ok my $intersection1 = Moose::Util::TypeConstraints::create_type_constraint_intersection(
+    'ArrayRef[Int|Str] & ArrayRef[Int | HashRef]') => 'Created Intersection1';
+
+ok my $intersection2 = Moose::Util::TypeConstraints::create_type_constraint_intersection(
+    'ArrayRef[  Int|Str] & ArrayRef[Int | HashRef]') => 'Created Intersection2';
+
+ok my $intersection3 = Moose::Util::TypeConstraints::create_type_constraint_intersection(
+    'ArrayRef[Int |Str   ] & ArrayRef[Int | HashRef  ]') => 'Created Intersection3';
+
+is $intersection1->name, $intersection2->name, 'names match';
+
+is $intersection1->name, $intersection3->name, 'names match';
+
+is $intersection2->name, $intersection3->name, 'names match';
+
+done_testing;
\ No newline at end of file
diff --git a/t/type_constraints/throw_error.t b/t/type_constraints/throw_error.t
index 662d327..ba34cc9 100644
--- a/t/type_constraints/throw_error.t
+++ b/t/type_constraints/throw_error.t
@@ -11,4 +11,9 @@ eval { Moose::Util::TypeConstraints::create_type_constraint_union() };
 like( $@, qr/\QYou must pass in at least 2 type names to make a union/,
       'can throw a proper error without Moose being loaded by the caller' );
 
+eval { Moose::Util::TypeConstraints::create_type_constraint_intersection() };
+
+like( $@, qr/\QYou must pass in at least 2 type names to make an intersection/,
+      'can throw a proper error without Moose being loaded by the caller' );
+
 done_testing;
diff --git a/t/type_constraints/type_notation_parser.t b/t/type_constraints/type_notation_parser.t
index a62e24a..8ceb167 100644
--- a/t/type_constraints/type_notation_parser.t
+++ b/t/type_constraints/type_notation_parser.t
@@ -104,4 +104,54 @@ ok(!Moose::Util::TypeConstraints::_detect_type_constraint_union($_),
     ) for keys %split_tests;
 }
 
+## now for the intersections
+
+ok(Moose::Util::TypeConstraints::_detect_type_constraint_intersection($_), 
+   '... this correctly detected intersection (' . $_ . ')')
+    for (
+    'Int & Str',
+    'Int&Str',    
+    'ArrayRef[Foo] & Int',
+    'ArrayRef[Foo]&Int',    
+    'Int & ArrayRef[Foo]',
+    'Int&ArrayRef[Foo]',    
+    'ArrayRef[Foo | Int] & Str',
+    'ArrayRef[Foo|Int]&Str',    
+    'Str & ArrayRef[Foo | Int]', 
+    'Str&ArrayRef[Foo|Int]',     
+    'Some&Silly&Name&With&Pipes & Int',   
+    'Some&Silly&Name&With&Pipes&Int',       
+);
+
+ok(!Moose::Util::TypeConstraints::_detect_type_constraint_intersection($_), 
+   '... this correctly detected a non-intersection (' . $_ . ')')
+    for (
+    'Int',
+    'ArrayRef[Foo | Int]',
+    'ArrayRef[Foo|Int]',    
+);
+
+{
+    my %split_tests = (
+        'Int & Str'                        => [ 'Int', 'Str' ],
+        'Int&Str'                          => [ 'Int', 'Str' ],        
+        'ArrayRef[Foo] & Int'              => [ 'ArrayRef[Foo]', 'Int' ],
+        'ArrayRef[Foo]&Int'                => [ 'ArrayRef[Foo]', 'Int' ],        
+        'Int & ArrayRef[Foo]'              => [ 'Int', 'ArrayRef[Foo]' ],
+        'Int&ArrayRef[Foo]'                => [ 'Int', 'ArrayRef[Foo]' ],        
+        'ArrayRef[Foo | Int] & Str'        => [ 'ArrayRef[Foo | Int]', 'Str' ],
+        'ArrayRef[Foo|Int]&Str'            => [ 'ArrayRef[Foo|Int]', 'Str' ],        
+        'Str & ArrayRef[Foo | Int]'        => [ 'Str', 'ArrayRef[Foo | Int]' ],  
+        'Str&ArrayRef[Foo|Int]'            => [ 'Str', 'ArrayRef[Foo|Int]' ],          
+        'Some&Silly&Name&With&Pipes & Int' => [ 'Some', 'Silly', 'Name', 'With', 'Pipes', 'Int' ],  
+        'Some&Silly&Name&With&Pipes&Int'   => [ 'Some', 'Silly', 'Name', 'With', 'Pipes', 'Int' ],         
+    );
+
+    is_deeply(
+        [ Moose::Util::TypeConstraints::_parse_type_constraint_intersection($_) ],
+        $split_tests{$_},
+        '... this correctly split the intersection (' . $_ . ')'
+    ) for keys %split_tests;
+}
+
 done_testing;