package App::Test::Generator::BenchmarkGenerator;

use 5.036;
use Carp qw(croak);
use Params::Get qw(get_params);
use Readonly;
use Scalar::Util qw(looks_like_number);

our $VERSION = '0.45';

Readonly my %TYPE_DEFAULTS => (
	number  => 42,
	integer => 42,
	float   => 3.14,
	string  => "'hello'",
	boolean => 1,
	arrayref => '[]',
	hashref  => '{}',
);

=head1 NAME

App::Test::Generator::BenchmarkGenerator - Generate Benchmark harnesses from ATG schemas

=head1 VERSION

Version 0.45

=head1 SYNOPSIS

    use App::Test::Generator::BenchmarkGenerator;
    use YAML::XS qw(LoadFile);

    my $schema = LoadFile('schemas/my_func.yml');
    my $bg     = App::Test::Generator::BenchmarkGenerator->new(schema => $schema);
    print $bg->generate();

=head1 DESCRIPTION

Given an ATG YAML schema (as produced by C<extract-schemas> or written by hand),
generates a self-contained Perl benchmark script using L<Benchmark/cmpthese>.

Each transform defined in the schema becomes one variant in the C<cmpthese> call,
with representative input values derived from the transform's type and range
constraints.  When no transforms are defined, a single C<'default'> variant is
emitted using the base input specification.

The generated script is a plain C<.pl> file suitable for running directly with
C<perl>.  It is not a test file and has no dependency on any test framework.

=head1 METHODS

=head2 new

=head3 API SPECIFICATION

=head4 input

    schema   => HashRef   (required) - ATG schema hashref as loaded from YAML

=head4 output

An C<App::Test::Generator::BenchmarkGenerator> object.

=cut

sub new {
	my ($class, @args) = @_;
	my $params = get_params('schema', \@args);
	croak 'schema is required' unless defined $params->{schema};
	croak 'schema must be a hashref' unless ref $params->{schema} eq 'HASH';
	return bless { schema => $params->{schema} }, $class;
}

=head2 generate

=head3 API SPECIFICATION

=head4 input

None (reads from the schema passed to C<new>).

=head4 output

A string containing the complete benchmark script, ready to write to a file.

=cut

sub generate {
	my $self = $_[0];

	my $schema   = $self->{schema};
	my $module   = $schema->{module}   // croak 'schema missing module';
	my $function = $schema->{function} // croak 'schema missing function';
	my $has_new  = exists $schema->{new};
	my %input    = %{ $schema->{input} // {} };
	my %xforms   = %{ $schema->{transforms} // {} };

	my $is_builtin = ($module eq 'builtin');

	my @lines;

	push @lines,
		'#!/usr/bin/env perl',
		"# Benchmark for $function (" . ($is_builtin ? 'builtin' : "module: $module") . ')',
		'# Generated by benchmark-generator (App::Test::Generator ' . $VERSION . ')',
		'# DO NOT EDIT -- regenerate with: benchmark-generator -i SCHEMA.yml',
		q{},
		'use strict;',
		'use warnings;',
		'use Benchmark qw(cmpthese);';

	unless($is_builtin) {
		push @lines, "use $module;";
	}

	push @lines,
		q{},
		'my $COUNT = -3;    # seconds per variant (negative = time-based)',
		q{};

	if($has_new && !$is_builtin) {
		my $new_spec = $schema->{new};
		if(ref $new_spec eq 'HASH' && %$new_spec) {
			my $args = join(', ', map { "$_ => " . _quote_value($new_spec->{$_}) } sort keys %$new_spec);
			push @lines, "my \$obj = ${module}->new($args);";
		} else {
			push @lines, "my \$obj = ${module}->new();";
		}
		push @lines, q{};
	}

	push @lines, "printf \"Benchmarking ${function}\\n\\n\";", q{};

	my %variants;
	if(%xforms) {
		for my $name (sort keys %xforms) {
			my %xinput = %{ $xforms{$name}{input} // \%input };
			$variants{$name} = _build_call($module, $function, $has_new, \%xinput);
		}
	} else {
		$variants{'default'} = _build_call($module, $function, $has_new, \%input);
	}

	push @lines, 'cmpthese($COUNT, {';
	my $name_width = length((sort { length($b) <=> length($a) } keys %variants)[0]);
	for my $name (sort keys %variants) {
		my $padded = sprintf "%-*s", $name_width, "'$name'";
		push @lines, "\t$padded => sub { $variants{$name} },";
	}
	push @lines, '});', q{};

	return join("\n", @lines);
}

# --------------------------------------------------
# _build_call
#
# Purpose:    Build the Perl expression that calls the target function
#             with representative values derived from the input spec.
#
# Entry:      $module   - module name string
#             $function - function/method name
#             $has_new  - true if schema has 'new:' key (OOP call)
#             $input    - hashref of param name → spec
#
# Exit:       Returns a Perl expression string suitable for use inside
#             an anonymous sub in a cmpthese() call.
# --------------------------------------------------
sub _build_call {
	my ($module, $function, $has_new, $input) = @_;

	my $has_positions = grep { defined $_->{position} } values %$input;
	my $call;

	if($has_positions) {
		my @positional = sort { $a->{position} <=> $b->{position} }
		                 grep { defined $_->{position} }
		                 values %$input;
		my $args = join(', ', map { _representative_value($_) } @positional);
		$call = $has_new ? "\$obj->$function($args)"
		                 : ($module eq 'builtin' ? "$function($args)"
		                                         : "${module}::$function($args)");
	} else {
		my @pairs = map { "$_ => " . _representative_value($input->{$_}) }
		            sort keys %$input;
		my $args = join(', ', @pairs);
		$call = $has_new ? "\$obj->$function($args)"
		                 : "${module}::$function($args)";
	}

	return $call;
}

# --------------------------------------------------
# _representative_value
#
# Purpose:    Return a Perl literal string that is a plausible representative
#             value for a parameter given its schema spec.  The choice is
#             informed by type, min, max, and enum constraints.
#
# Entry:      $spec - hashref with at minimum a 'type' key
#
# Exit:       Returns a Perl literal string (e.g. '42', "'hello'", 'undef').
# --------------------------------------------------
sub _representative_value {
	my ($spec) = @_;
	return 'undef' unless defined $spec;

	my $type = lc($spec->{type} // 'string');

	if($type eq 'number' || $type eq 'integer' || $type eq 'float') {
		my $min = $spec->{min};
		my $max = $spec->{max};
		my $default = $TYPE_DEFAULTS{$type} // 42;
		if(defined $min && looks_like_number($min) && defined $max && looks_like_number($max)) {
			return int(($min + $max) / 2);
		}
		if(defined $min && looks_like_number($min)) {
			# pick the type default if it already satisfies >= min, else min+1
			return $default > $min ? $default : $min + 1;
		}
		if(defined $max && looks_like_number($max)) {
			# pick the type default if it already satisfies <= max, else max-1
			return $default < $max ? $default : $max - 1;
		}
		return $default;
	}

	return $TYPE_DEFAULTS{$type} // "'value'";
}

# --------------------------------------------------
# _quote_value
#
# Purpose:    Quote a scalar value for use in generated Perl source.
#
# Entry:      $v - scalar value (undef, number, or string)
#
# Exit:       Returns a Perl literal string.
# --------------------------------------------------
sub _quote_value {
	my ($v) = @_;
	return 'undef' unless defined $v;
	return $v if looks_like_number($v);
	(my $escaped = $v) =~ s/'/\\'/g;
	return "'$escaped'";
}

=head1 AUTHOR

Nigel Horne

=head1 LICENSE

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

=cut

1;
