<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Type::Tiny::Union;

use 5.006001;
use strict;
use warnings;

BEGIN {
	$Type::Tiny::Union::AUTHORITY = 'cpan:TOBYINK';
	$Type::Tiny::Union::VERSION   = '1.002001';
}

use Scalar::Util qw&lt; blessed &gt;;
use Types::TypeTiny ();

sub _croak ($;@) { require Error::TypeTiny; goto \&amp;Error::TypeTiny::croak }

use overload q[@{}] =&gt; sub { $_[0]{type_constraints} ||= [] };

use Type::Tiny ();
our @ISA = 'Type::Tiny';

sub new {
	my $proto = shift;
	
	my %opts = (@_==1) ? %{$_[0]} : @_;
	_croak "Union type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent};
	_croak "Union type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint};
	_croak "Union type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined};
	_croak "Need to supply list of type constraints" unless exists $opts{type_constraints};
	
	$opts{type_constraints} = [
		map { $_-&gt;isa(__PACKAGE__) ? @$_ : $_ }
		map Types::TypeTiny::to_TypeTiny($_),
		@{ ref $opts{type_constraints} eq "ARRAY" ? $opts{type_constraints} : [$opts{type_constraints}] }
	];
	
	if (Type::Tiny::_USE_XS)
	{
		my @constraints = @{$opts{type_constraints}};
		my @known = map {
			my $known = Type::Tiny::XS::is_known($_-&gt;compiled_check);
			defined($known) ? $known : ();
		} @constraints;
		
		if (@known == @constraints)
		{
			my $xsub = Type::Tiny::XS::get_coderef_for(
				sprintf "AnyOf[%s]", join(',', @known)
			);
			$opts{compiled_type_constraint} = $xsub if $xsub;
		}
	}

	my $self = $proto-&gt;SUPER::new(%opts);
	$self-&gt;coercion if grep $_-&gt;has_coercion, @$self;
	return $self;
}

sub type_constraints { $_[0]{type_constraints} }
sub constraint       { $_[0]{constraint} ||= $_[0]-&gt;_build_constraint }

sub _build_display_name
{
	my $self = shift;
	join q[|], @$self;
}

sub _build_coercion
{
	require Type::Coercion::Union;
	my $self = shift;
	return "Type::Coercion::Union"-&gt;new(type_constraint =&gt; $self);
}

sub _build_constraint
{
	my @checks = map $_-&gt;compiled_check, @{+shift};
	return sub
	{
		my $val = $_;
		$_-&gt;($val) &amp;&amp; return !!1 for @checks;
		return;
	}
}

sub can_be_inlined
{
	my $self = shift;
	not grep !$_-&gt;can_be_inlined, @$self;
}

sub inline_check
{
	my $self = shift;
	
	if (Type::Tiny::_USE_XS and !exists $self-&gt;{xs_sub})
	{
		$self-&gt;{xs_sub} = undef;
		
		my @constraints = @{$self-&gt;type_constraints};
		my @known = map {
			my $known = Type::Tiny::XS::is_known($_-&gt;compiled_check);
			defined($known) ? $known : ();
		} @constraints;
		
		if (@known == @constraints)
		{
			$self-&gt;{xs_sub} = Type::Tiny::XS::get_subname_for(
				sprintf "AnyOf[%s]", join(',', @known)
			);
		}
	}
	
	if (Type::Tiny::_USE_XS and $self-&gt;{xs_sub}) {
		return "$self-&gt;{xs_sub}\($_[0]\)";
	}
	
	sprintf '(%s)', join " or ", map $_-&gt;inline_check($_[0]), @$self;
}

sub _instantiate_moose_type
{
	my $self = shift;
	my %opts = @_;
	delete $opts{parent};
	delete $opts{constraint};
	delete $opts{inlined};
	
	my @tc = map $_-&gt;moose_type, @{$self-&gt;type_constraints};
	
	require Moose::Meta::TypeConstraint::Union;
	return "Moose::Meta::TypeConstraint::Union"-&gt;new(%opts, type_constraints =&gt; \@tc);
}

sub has_parent
{
	defined(shift-&gt;parent);
}

sub parent
{
	$_[0]{parent} ||= $_[0]-&gt;_build_parent;
}

sub _build_parent
{
	my $self = shift;
	my ($first, @rest) = @$self;
	
	for my $parent ($first, $first-&gt;parents)
	{
		return $parent unless grep !$_-&gt;is_a_type_of($parent), @rest;
	}
	
	return;
}

sub find_type_for
{
	my @types = @{+shift};
	for my $type (@types)
	{
		return $type if $type-&gt;check(@_);
	}
	return;
}

sub validate_explain
{
	my $self = shift;
	my ($value, $varname) = @_;
	$varname = '$_' unless defined $varname;
	
	return undef if $self-&gt;check($value);
	
	require Type::Utils;
	return [
		sprintf(
			'"%s" requires that the value pass %s',
			$self,
			Type::Utils::english_list(\"or", map qq["$_"], @$self),
		),
		map {
			$_-&gt;get_message($value),
			map("    $_", @{ $_-&gt;validate_explain($value) || []}),
		} @$self
	];
}

sub equals
{
	my ($self, $other) = Type::Tiny::_loose_to_TypeTiny(@_);
	return unless blessed($self)  &amp;&amp; $self-&gt;isa("Type::Tiny");
	return unless blessed($other) &amp;&amp; $other-&gt;isa("Type::Tiny");
	
	return !!1 if $self-&gt;SUPER::equals($other);
	return !!0 unless $other-&gt;isa(__PACKAGE__);
	
	my @self_constraints  = @{ $self-&gt;type_constraints };
	my @other_constraints = @{ $other-&gt;type_constraints };
	
	return !!0 unless @self_constraints == @other_constraints;
	
	constraint: foreach my $constraint ( @self_constraints ) {
		for ( my $i = 0; $i &lt; @other_constraints; $i++ ) {
			if ( $constraint-&gt;equals($other_constraints[$i]) ) {
				splice @other_constraints, $i, 1;
				next constraint;
			}
		}
	}
	
	@other_constraints == 0;
}

sub is_a_type_of
{
	my ($self, $other) = Type::Tiny::_loose_to_TypeTiny(@_);
	return unless blessed($self)  &amp;&amp; $self-&gt;isa("Type::Tiny");
	return unless blessed($other) &amp;&amp; $other-&gt;isa("Type::Tiny");
	
	return !!1 if $self-&gt;SUPER::is_a_type_of($other);
	
	for my $tc (@{ $self-&gt;type_constraints }) {
		return !!0 unless $tc-&gt;is_a_type_of($other);
	}
	return !!1;
}

sub is_subtype_of
{
	my ($self, $other) = Type::Tiny::_loose_to_TypeTiny(@_);
	return unless blessed($self)  &amp;&amp; $self-&gt;isa("Type::Tiny");
	return unless blessed($other) &amp;&amp; $other-&gt;isa("Type::Tiny");
	
	return !!1 if $self-&gt;SUPER::is_subtype_of($other);
	
	for my $tc (@{ $self-&gt;type_constraints }) {
		return !!0 unless $tc-&gt;is_subtype_of($other);
	}
	return !!1;
}

sub is_supertype_of
{
	my ($self, $other) = Type::Tiny::_loose_to_TypeTiny(@_);
	return unless blessed($self)  &amp;&amp; $self-&gt;isa("Type::Tiny");
	return unless blessed($other) &amp;&amp; $other-&gt;isa("Type::Tiny");
	
	return !!1 if $self-&gt;SUPER::is_supertype_of($other);
	
	for my $tc (@{ $self-&gt;type_constraints }) {
		return !!1 if $tc-&gt;equals($other);
		return !!1 if $tc-&gt;is_supertype_of($other);
	}
	return !!0;
}

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Type::Tiny::Union - union type constraints

=head1 STATUS

This module is covered by the
L&lt;Type-Tiny stability policy|Type::Tiny::Manual::Policies/"STABILITY"&gt;.

=head1 DESCRIPTION

Union type constraints.

This package inherits from L&lt;Type::Tiny&gt;; see that for most documentation.
Major differences are listed below:

=head2 Attributes

=over

=item C&lt;type_constraints&gt;

Arrayref of type constraints.

When passed to the constructor, if any of the type constraints in the union
is itself a union type constraint, this is "exploded" into the new union.

=item C&lt;constraint&gt;

Unlike Type::Tiny, you I&lt;cannot&gt; pass a constraint coderef to the constructor.
Instead rely on the default.

=item C&lt;inlined&gt;

Unlike Type::Tiny, you I&lt;cannot&gt; pass an inlining coderef to the constructor.
Instead rely on the default.

=item C&lt;parent&gt;

Unlike Type::Tiny, you I&lt;cannot&gt; pass an inlining coderef to the constructor.
A parent will instead be automatically calculated.

=item C&lt;coercion&gt;

You probably do not pass this to the constructor. (It's not currently
disallowed, as there may be a use for it that I haven't thought of.)

The auto-generated default will be a L&lt;Type::Coercion::Union&gt; object.

=back

=head2 Methods

=over

=item C&lt;&lt; find_type_for($value) &gt;&gt;

Returns the first individual type constraint in the union which
C&lt;&lt; $value &gt;&gt; passes.

=back

=head2 Overloading

=over

=item *

Arrayrefification calls C&lt;type_constraints&gt;.

=back

=head1 BUGS

Please report any bugs to
L&lt;http://rt.cpan.org/Dist/Display.html?Queue=Type-Tiny&gt;.

=head1 SEE ALSO

L&lt;Type::Tiny::Manual&gt;.

L&lt;Type::Tiny&gt;.

=head1 AUTHOR

Toby Inkster E&lt;lt&gt;tobyink@cpan.orgE&lt;gt&gt;.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2013-2014, 2017 by Toby Inkster.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

</pre></body></html>