From 1b833b72b80e00da9e8fc2eeb22a327924407dd8 Mon Sep 17 00:00:00 2001
From: Colin Newell <colin.newell@gmail.com>
Date: Wed, 22 Nov 2017 19:41:33 +0000
Subject: [PATCH 1/2] Support | overload to work better with MooseX::Types

Copied override from MooseX::Types::TypeDecorator to allow
union from all types.  In theory this should mean we can
remove it from MooseX::Types.

Allow:

    my $type2 = $type1 | class_type('Bar');

as well as:

    my $type1 = HashRef | class_type('Foo');

For RT#98809.
---
 lib/Moose/Meta/TypeConstraint.pm | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index 3239b5145..8407179d7 100644
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -6,6 +6,29 @@ use warnings;
 use metaclass;
 
 use overload '0+'     => sub { refaddr(shift) }, # id an object
+             '|'      => sub {
+
+                 ## It's kind of ugly that we need to know about Union Types, but this
+                 ## is needed for syntax compatibility.  Maybe someday we'll all just do
+                 ## Or[Str,Str,Int]
+
+                 my @args = @_[0,1]; ## arg 3 is special,  see the overload docs.
+                 my @tc = grep {blessed $_} map {
+                     blessed $_ ? $_ :
+                     Moose::Util::TypeConstraints::find_or_parse_type_constraint($_)
+                       || __PACKAGE__->_throw_error( "$_ is not a type constraint")
+                 } @args;
+
+                 ( scalar @tc == scalar @args)
+                     || __PACKAGE__->_throw_error(
+                       "one of your type constraints is bad.  Passed: ". join(', ', @args) ." Got: ". join(', ', @tc));
+
+                 ( scalar @tc >= 2 )
+                     || __PACKAGE__->_throw_error("You must pass in at least 2 type names to make a union");
+
+                 my $union = Moose::Meta::TypeConstraint::Union->new(type_constraints=>\@tc);
+                 return Moose::Util::TypeConstraints::register_type_constraint($union);
+             },
              '""'     => sub { shift->name },   # stringify to tc name
              bool     => sub { 1 },
              fallback => 1;

From 9a680ccf50a3c531dbd32ae2af0b70b41d571ba6 Mon Sep 17 00:00:00 2001
From: Colin Newell <colin.newell@gmail.com>
Date: Wed, 22 Nov 2017 20:27:21 +0000
Subject: [PATCH 2/2] Create a test

---
 t/type_constraints/union_overload_or.t | 56 ++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)
 create mode 100644 t/type_constraints/union_overload_or.t

diff --git a/t/type_constraints/union_overload_or.t b/t/type_constraints/union_overload_or.t
new file mode 100644
index 000000000..edabf5932
--- /dev/null
+++ b/t/type_constraints/union_overload_or.t
@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+
+use Test::Fatal;
+use Test::More;
+
+{
+
+    package Duck;
+    use Moose;
+
+    sub quack { }
+
+}
+
+{
+
+    package Swan;
+    use Moose;
+
+    sub honk { }
+
+}
+
+{
+
+    package RubberDuck;
+    use Moose;
+
+    sub quack { }
+
+}
+
+
+use Moose::Util::TypeConstraints 'class_type';
+
+my $union = class_type('Duck') | class_type('RubberDuck');
+
+my $duck = Duck->new();
+my $rubber_duck = RubberDuck->new();
+my $swan = Swan->new();
+
+my @domain_values = ( $duck, $rubber_duck );
+is(
+    exception { $union->assert_valid($_) },
+    undef,
+    qq{Union accepts "$_".}
+) for @domain_values;
+
+like(
+    exception { $union->assert_valid($swan) },
+    qr/Validation failed for/,
+    qq{Union does not accept Swan.}
+);
+done_testing;
+