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

Test L<Type::Utils> C<match_on_type> and C<compile_match_on_type> functions.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2013-2014 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 Test::More;
use Test::Fatal;

use Type::Utils qw( match_on_type compile_match_on_type );
use Types::Standard -types;

sub to_json;

*to_json = compile_match_on_type(
	HashRef() => sub {
		my $hash = shift;
		'{ '
			. (
			join ", " =>
			map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) }
			sort keys %$hash
		) . ' }';
	},
	ArrayRef() => sub {
		my $array = shift;
		'[ ' . ( join ", " => map { to_json($_) } @$array ) . ' ]';
	},
	Num()   => q {$_},
	Str()   => q { '"' . $_ . '"' },
	Undef() => q {'null'},
	=> sub { die "$_ is not acceptable json type" },
);

is(
	to_json({foo => 1, bar => 2, baz => [3 .. 5], quux => undef}),
	'{ "bar" : 2, "baz" : [ 3, 4, 5 ], "foo" : 1, "quux" : null }',
	'to_json using compile_match_on_type works',
);

sub to_json_2
{
	return match_on_type $_[0] => (
		HashRef() => sub {
			my $hash = shift;
			'{ '
				. (
				join ", " =>
				map { '"' . $_ . '" : ' . to_json_2( $hash->{$_} ) }
				sort keys %$hash
			) . ' }';
		},
		ArrayRef() => sub {
			my $array = shift;
			'[ ' . ( join ", " => map { to_json_2($_) } @$array ) . ' ]';
		},
		Num()   => q {$_},
		Str()   => q { '"' . $_ . '"' },
		Undef() => q {'null'},
		=> sub { die "$_ is not acceptable json type" },
	);
}

is(
	to_json_2({foo => 1, bar => 2, baz => [3 .. 5], quux => undef}),
	'{ "bar" : 2, "baz" : [ 3, 4, 5 ], "foo" : 1, "quux" : null }',
	'to_json_2 using match_on_type works',
);

if ($ENV{EXTENDED_TESTING})
{
	require Benchmark;
	my $iters = 5_000;
	
	my $standard = Benchmark::timethis(
		$iters,
		'::to_json_2({foo => 1, bar => 2, baz => [3 .. 5], quux => undef})',
		'standard',
		'none',
	);
	diag "match_on_type: " . Benchmark::timestr($standard);
	
	my $compiled = Benchmark::timethis(
		$iters,
		'::to_json({foo => 1, bar => 2, baz => [3 .. 5], quux => undef})',
		'compiled',
		'none',
	);
	diag "compile_match_on_type: " . Benchmark::timestr($compiled);
}

done_testing;