The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
=pod

=encoding utf-8

=head1 PURPOSE

Checks the C<Split> and C<Join> parameterized coercions from
L<Types::Standard>.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<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.

=cut

use strict;
use warnings;
use lib qw( . ./t ../inc ./inc );
use utf8;

use Test::More;
use Test::Requires { "Encode" => 0 };
use Test::TypeTiny;

use Encode;
use Types::Standard qw( Str ArrayRef HashRef Join Split );
use Type::Utils;

my $chars          = "Café Paris|Garçon";
my $bytes_utf8     = Encode::encode("utf-8",      $chars);
my $bytes_western  = Encode::encode("iso-8859-1", $chars);

is(length($chars),         17, 'length $chars == 17');
is(length($bytes_utf8),    19, 'length $bytes_utf8 == 19');
is(length($bytes_western), 17, 'length $bytes_western == 17');

my $SplitSpace = (ArrayRef[Str])->plus_coercions(Split[qr/\s/]);
my $SplitPipe  = (ArrayRef[Str])->plus_coercions(Split[qr/\|/]);

ok($SplitSpace->can_be_inlined, '$SplitSpace can be inlined');
ok($SplitPipe->can_be_inlined, '$SplitPipe can be inlined');

is_deeply(
	$SplitSpace->coerce($chars),
	[ "Café", "Paris|Garçon" ],
	'$SplitSpace->coerce($chars)',
);

is_deeply(
	$SplitSpace->coerce($bytes_utf8),
	[ map Encode::encode("utf-8", $_), "Café", "Paris|Garçon" ],
	'$SplitSpace->coerce($bytes_utf8)',
);

is_deeply(
	$SplitSpace->coerce($bytes_western),
	[ map Encode::encode("iso-8859-1", $_), "Café", "Paris|Garçon" ],
	'$SplitSpace->coerce($bytes_western)',
);

should_pass($SplitSpace->coerce($chars), ArrayRef[Str]);
should_pass($SplitSpace->coerce($bytes_utf8), ArrayRef[Str]);
should_pass($SplitSpace->coerce($bytes_western), ArrayRef[Str]);

is_deeply(
	my $arr_chars = $SplitPipe->coerce($chars),
	[ "Café Paris", "Garçon" ],
	'$SplitPipe->coerce($chars)',
);

is_deeply(
	my $arr_bytes_utf8 = $SplitPipe->coerce($bytes_utf8),
	[ map Encode::encode("utf-8", $_), "Café Paris", "Garçon" ],
	'$SplitPipe->coerce($bytes_utf8)',
);

is_deeply(
	my $arr_bytes_western = $SplitPipe->coerce($bytes_western),
	[ map Encode::encode("iso-8859-1", $_), "Café Paris", "Garçon" ],
	'$SplitPipe->coerce($bytes_western)',
);

my $JoinPipe = Str->plus_coercions(Join["|"]);

is(
	$_ = $JoinPipe->coerce($arr_chars),
	$chars,
	'$JoinPipe->coerce($arr_chars)',
);
should_pass($_, Str);

is(
	$_ = $JoinPipe->coerce($arr_bytes_utf8),
	$bytes_utf8,
	'$JoinPipe->coerce($arr_bytes_utf8)',
);
should_pass($_, Str);

is(
	$_ = $JoinPipe->coerce($arr_bytes_western),
	$bytes_western,
	'$JoinPipe->coerce($arr_bytes_western)',
);
should_pass($_, Str);

# Re-parameterization stuff:
{
	# A type constraint with a useless parameter...
	#
	my $Stringy = Str->create_child_type(
		name                  => 'Stringy',
		parent                => Str,
		constraint_generator  => sub { sub {} },
	);
	
	ok($Stringy->is_parameterizable, '$Stringy->is_parameterizable');
	
	# A parameterizable coercion...
	my $Joiny = 'Type::Coercion'->new(
		name                  => 'Joiny',
		type_constraint       => $Stringy,
		type_coercion_map     => [ HashRef, sub { 'hello' } ],
		coercion_generator    => sub {
			my ($self, $type, $from, $to) = @_;
			my $joinchar = ':';
			if ($type->is_a_type_of($Stringy) and $type->is_parameterized) {
				$joinchar = $type->type_parameter;
			}
			return (
				@{ $self->type_coercion_map },
				ArrayRef,
				sub { my @arr = @$_; join($joinchar, @arr[$from..$to]) },
			);
		},
	);
	
	isa_ok(
		$Joiny,
		'Type::Coercion',
		'parameterizable coercion',
	);
	is(
		$Joiny->coerce({}),
		'hello',
		'... coercion included in base definition works'
	);
	is_deeply(
		$Joiny->coerce(['a'..'z']),
		['a'..'z'],
		'... coercion generated by parameterization does not exist yet'
	);
	
	my $Joiny23 = $Joiny->parameterize(2, 3);
	isa_ok(
		$Joiny23,
		'Type::Coercion',
		'parameterized coercion which has not yet been combined with type constraint',
	);
	is(
		$Joiny23->coerce({}),
		'hello',
		'... coercion included in base definition works'
	);
	is(
		$Joiny23->coerce(['a'..'z']),
		'c:d',
		'... coercion generated by parameterization works'
	);
	
	my $StringyPipe = $Stringy->parameterize('|')->plus_coercions($Joiny23);
	isa_ok(
		$StringyPipe,
		'Type::Tiny',
		'type constraint consuming parameterized coercion',
	);
	is(
		$StringyPipe->coerce({}),
		'hello',
		'... coercion included in base definition works'
	);
	is(
		$StringyPipe->coerce(['a'..'z']),
		'c|d',
		'... coercion generated by parameterization works; must have been regenerated'
	);
}

done_testing;