Bring multisig functionality into the v2 API

2 files changed, 194 insertions, 2 deletions

diff --git a/lib/Type/Params/Alternatives.pm b/lib/Type/Params/Alternatives.pm
new file mode 100644
index 00000000..3b77e6c1
--- /dev/null
+++ b/lib/Type/Params/Alternatives.pm
@@ -0,0 +1,159 @@
+package Type::Params::Alternatives;
+
+use 5.008001;
+use strict;
+use warnings;
+
+BEGIN {
+	if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat }
+}
+
+BEGIN {
+	$Type::Params::Alternatives::AUTHORITY  = 'cpan:TOBYINK';
+	$Type::Params::Alternatives::VERSION    = '1.999_004';
+}
+
+$Type::Params::Alternatives::VERSION =~ tr/_//d;
+
+use B ();
+use Eval::TypeTiny::CodeAccumulator;
+use Types::Standard qw( -is -types -assert );
+use Types::TypeTiny qw( -is -types to_TypeTiny );
+
+require Type::Params::Signature;
+our @ISA = 'Type::Params::Signature';
+
+sub new {
+	my $class = shift;
+	my %self  = @_ == 1 ? %{$_[0]} : @_;
+	my $self = bless \%self, $class;
+	exists( $self->{$_} ) || ( $self->{$_} = $self->{base_options}{$_} )
+		for keys %{ $self->{base_options} };
+	$self->{sig_class} ||= 'Type::Params::Signature';
+	$self->{message}   ||= 'Parameter validation failed';
+	return $self;
+}
+
+sub base_options      { $_[0]{base_options}      ||= {} }
+sub alternatives      { $_[0]{alternatives}      ||= [] }
+sub sig_class         { $_[0]{sig_class} }
+sub meta_alternatives { $_[0]{meta_alternatives} ||= $_[0]->_build_meta_alternatives }
+sub parameters        { [] }
+
+sub _build_meta_alternatives {
+	my $self = shift;
+
+	my $index = 0;
+	return [
+		map {
+			my $meta = $self->_build_meta_alternative( $_ );
+			$meta->{_index} = $index++;
+			$meta;
+		} @{ $self->alternatives }
+	];
+}
+
+sub _build_meta_alternative {
+	my ( $self, $alt ) = @_;
+
+	if ( is_CodeRef $alt ) {
+		return {
+			closure => $alt,
+		};
+	}
+	elsif ( is_HashRef $alt ) {
+		my %opts = (
+			%{ $self->base_options },
+			%$alt,
+			want_source  => !!0,
+			want_details => !!1,
+		);
+		my $sig = $self->sig_class->new_from_v2api( \%opts );
+		return $sig->return_wanted;
+	}
+	elsif ( is_ArrayRef $alt ) {
+		my %opts = (
+			%{ $self->base_options },
+			positional   => $alt,
+			want_source  => !!0,
+			want_details => !!1,
+		);
+		my $sig = $self->sig_class->new_from_v2api( \%opts );
+		return $sig->return_wanted;
+	}
+	else {
+		$self->_croak( 'Alternative signatures must be CODE, HASH, or ARRAY refs' );
+	}
+}
+
+sub _build_coderef {
+	my $self = shift;
+	my $coderef = $self->_new_code_accumulator(
+		description => $self->base_options->{description}
+			|| sprintf( 'parameter validation for "%s::%s"', $self->base_options->{package} || '', $self->base_options->{subname} || '__ANON__' )
+	);
+
+	$self->_coderef_start( $coderef );
+
+	$coderef->add_line( 'my $return;' );
+	$coderef->add_gap;
+
+	for my $meta ( @{ $self->meta_alternatives } ) {
+		$self->_coderef_meta_alternative( $coderef, $meta );
+	}
+
+	$self->_coderef_end( $coderef );
+
+	return $coderef;
+}
+
+sub _coderef_meta_alternative {
+	my ( $self, $coderef, $meta ) = ( shift, @_ );
+
+	my @cond = '! $return';
+	push @cond, sprintf( '@_ >= %s', $meta->{min_args} ) if defined $meta->{min_args};
+	push @cond, sprintf( '@_ <= %s', $meta->{max_args} ) if defined $meta->{max_args};
+	if ( defined $meta->{max_args} and defined $meta->{min_args} ) {
+		splice @cond, -2, 2, sprintf( '@_ == %s', $meta->{min_args} )
+			if $meta->{max_args} == $meta->{min_args};
+	}
+
+	my $callback_var = $coderef->add_variable( '$alt', \$meta->{closure} );
+	$coderef->add_line( sprintf(
+		'eval { $return = [ %s->(@_) ]; ${^TYPE_PARAMS_MULTISIG} = %d }%sif ( %s );',
+		$callback_var,
+		$meta->{_index},
+		"\n\t",
+		join( ' and ', @cond ),
+	) );
+	$coderef->add_gap;
+
+	return $self;
+}
+
+sub _coderef_end {
+	my ( $self, $coderef ) = ( shift, @_ );
+	
+	$coderef->add_line( sprintf(
+		'%s unless $return;',
+		$self->_make_general_fail( message => B::perlstring( $self->{message} ) ),
+	) );
+	$coderef->add_gap;
+	
+	$coderef->add_line( $self->_make_return_expression( is_early => 0 ) );
+	
+	$coderef->{indent} =~ s/\t$//;
+	$coderef->add_line( '}' );
+	return $self;
+}
+
+sub _coderef_check_count {
+	shift;
+}
+
+sub _make_return_list {
+	'@$return';
+}
+
+1;
+
diff --git a/lib/Type/Params/Signature.pm b/lib/Type/Params/Signature.pm
index 77f52dbf..7d7af15c 100644
--- a/lib/Type/Params/Signature.pm
+++ b/lib/Type/Params/Signature.pm
@@ -22,8 +22,8 @@ use Types::TypeTiny qw( -is -types to_TypeTiny );
 use Type::Params::Parameter;
 
 sub _croak {
-	require Carp;
-	Carp::croak( pop );
+	require Error::TypeTiny;
+	return Error::TypeTiny::croak( pop );
 }
 
 sub _new_parameter {
@@ -220,6 +220,39 @@ sub new_from_compile {
 	return $self;
 }
 
+sub new_from_v2api {
+	my ( $class, $opts ) = @_;
+
+	my $positional = delete( $opts->{positional} ) || delete( $opts->{pos} );
+	my $named      = delete( $opts->{named} );
+	my $multiple   = delete( $opts->{multiple} ) || delete( $opts->{multi} );
+
+	$class->_croak( "Signature must have a positional or named argument" )
+		unless $positional || $named || $multiple;
+
+	if ( $multiple ) {
+		$multiple = [] unless is_ArrayRef $multiple;
+		unshift @$multiple, { positional => $positional } if $positional;
+		unshift @$multiple, { named      => $named      } if $named;
+		require Type::Params::Alternatives;
+		return 'Type::Params::Alternatives'->new(
+			base_options => $opts,
+			alternatives => $multiple,
+			sig_class    => $class,
+		);
+	}
+
+	my ( $sig_kind, $args ) = ( pos => $positional );
+	if ( $named ) {
+		$opts->{bless} = 1 unless exists $opts->{bless};
+		( $sig_kind, $args ) = ( named => $named );
+		$class->_croak( "Signature cannot have both positional and named arguments" )
+			if $positional;
+	}
+
+	return $class->new_from_compile( $sig_kind, $opts, @$args );
+}
+
 sub package       { $_[0]{package} }
 sub subname       { $_[0]{subname} }
 sub description   { $_[0]{description} }     sub has_description   { exists $_[0]{description} }