## no critic: TestingAndDebugging::ProhibitProlongedStrictureOverride

package Dist::Zilla::Plugin::Rinci::GenSchemaV;

our $DATE = '2019-07-04'; # DATE
our $VERSION = '0.000'; # VERSION

use 5.010001;
use strict;
use warnings;
use Moose;

use Data::Dmp;
use Data::Sah;
use Digest::SHA qw(sha1_hex);
use PMVersions::Util qw(version_from_pmversions);

with (
    'Dist::Zilla::Role::FileGatherer',
    'Dist::Zilla::Role::FileMunger',
    'Dist::Zilla::Role::FileFinderUser' => {
        default_finders => [':InstallModules'],
    },
);

use namespace::autoclean;

sub _add_prereq {
    my ($self, $mod, $ver) = @_;
    return if defined($self->{_added_prereqs}{$mod}) &&
        $self->{_added_prereqs}{$mod} >= $ver;
    $self->log("Adding prereq: $mod => $ver");
    $self->zilla->register_prereqs({phase=>'runtime'}, $mod, $ver);
    $self->{_added_prereqs}{$mod} = $ver;
}

sub gather_files {
    # we add files in the munge_files() phase because at this point,
    # found_files() doesn't yet work
}

sub munge_files {
    my $self = shift;

    $self->munge_file($_) for @{ $self->found_files };
    return;
}

sub munge_file {
    no strict 'refs';

    my ($self, $file) = @_;

    my $fname = $file->name;

    unless ($file->isa("Dist::Zilla::File::OnDisk")) {
        $self->log_debug(["skipping %s: not an ondisk file, currently only ondisk files are processed", $fname]);
        return;
    }

    $self->log_debug("Processing file $fname ...");

    unless ($fname =~ m!lib/(.+\.pm)$!) {
        #$self->log_debug("Skipping: '$fname' not a module");
        return;
    }
    my $mod_pm = $1;

    # i do it this way (unshift @INC, "lib" + require "Foo/Bar.pm" instead of
    # unshift @INC, "." + require "lib/Foo/Bar.pm") in my all other Dist::Zilla
    # and Pod::Weaver plugin, so they can work together (require "Foo/Bar.pm"
    # and require "lib/Foo/Bar.pm" would cause Perl to load the same file twice
    # and generate redefine warnings).

    local @INC = ("lib", @INC);

    eval { require $mod_pm };
    if ($@) {
        $self->log_fatal("$fname: has compile errors: $@");
    }

    (my $mod = $mod_pm) =~ s/\.pm$//; $mod =~ s!/!::!g;
    my $metas = \%{"$mod\::SPEC"};

    my $schemav_mod = "Sah::SchemaV::$mod";
    (my $schemav_mod_pm = "$schemav_mod.pm") =~ s!::!/!g;

    my $sah = Data::Sah->new;
    my $plc = $sah->get_compiler("perl");

    my @code;
    push @code, "package $schemav_mod;\n\n";

    push @code, "# DATE\n";
    push @code, "# VERSION\n\n";

    push @code, "# This file is generated by ".__PACKAGE__." version ".(${__PACKAGE__."::VERSION"} // "dev")." on ".scalar(localtime()).".\n\n";

    push @code, "our \%Validators;\n";
    push @code, "our \%Args_Validators;\n\n";

    my %seen_keys;
    for my $ent_name (sort keys %$metas) {
        next unless $ent_name =~ /\A\w+\z/; # a function ...
        my $meta = $metas->{$ent_name};
        next unless $meta->{args}; # ... that has args
        for my $arg_name (sort keys %{ $meta->{args} }) {
            my $arg_spec = $meta->{args}{$arg_name};
            my $schema = $arg_spec->{schema};
            next unless $schema;
            my $dmp_schema = dmp($schema);
            my $key = sha1_hex($dmp_schema);
            unless ($seen_keys{$key}) {
                my %cargs = (schema => $schema, return_type=>'str+val');
                my $cd = $plc->compile(%cargs);

                for my $mod_rec (@{$cd->{modules}}) {
                    next unless $mod_rec->{phase} eq 'runtime';
                    $self->_add_prereq($mod_rec->{name} => $mod_rec->{version} // version_from_pmversions($mod_rec->{name}) // 0);
                }
                my $comment = "schema is: $dmp_schema"; $comment =~ s/^/# /gm;
                push @code, "$comment\n";
                push @code, "\$Validators{'$key'} = " . $plc->expr_validator_sub(%cargs, cd=>$cd) . ";\n\n";
                $seen_keys{$key}++;
            }
            push @code, "\$Args_Validators{'$ent_name'}{'$arg_name'} = \$Validators{'$key'};\n\n";
        }
    }

    return unless keys %seen_keys;
    push @code, "1;\n";
    push @code, "# ABSTRACT: Generated validator code for $mod\n\n";

    push @code, "=head1 DESCRIPTION\n\n";

    push @code, "This module is generated by ".__PACKAGE__." version ".(${__PACKAGE__."::VERSION"} // "dev")." on ".scalar(localtime()).".\n\n";

  CREATE_SCHEMAV:
    {
        require Dist::Zilla::File::InMemory;
        my $filename = "lib/$schemav_mod_pm";
        my $file = Dist::Zilla::File::InMemory->new(
            name => $filename,
            content => join("", @code),
        );
        $self->log(["Creating file %s", $filename]);
        $self->add_file($file);
    }
}

__PACKAGE__->meta->make_immutable;
1;
# ABSTRACT: Generate Sah::SchemaV::* modules for all modules that contain Rinci function metadata

__END__

=pod

=encoding UTF-8

=head1 NAME

Dist::Zilla::Plugin::Rinci::GenSchemaV - Generate Sah::SchemaV::* modules for all modules that contain Rinci function metadata

=head1 VERSION

This document describes version 0.000 of Dist::Zilla::Plugin::Rinci::GenSchemaV (from Perl distribution Dist-Zilla-Plugin-Rinci-GenSchemaV), released on 2019-07-04.

=head1 SYNOPSIS

In F<dist.ini>:

 [Rinci::GenSchemaV]

=head1 DESCRIPTION

This plugin will generate a corresponding C<Sah::SchemaV::*> modules for all
modules that contain Rinci function metadata. For example, if F<lib/My/Lib.pm>
contains:

 package My::Lib;

 our %SPEC;

 $SPEC{func1} = {
     v => 1.1,
     summary => 'Blah blah',
     args => {
         arg1 => {
             summary => 'Blah blah',
             schema => ['str*', len_between=>[1, 10]],
         },
         arg2 => {
             summary => 'Blah blah',
             schema => ['str*', len_between=>[1, 10]],
         },
         arg3 => {
             summary => 'Blah blah',
             schema => 'uint*',
         },
     },
 };
 sub func1 {
    ...
 }

 1;

then this plugin will generate F<lib/Sah/SchemaV/My/Lib.pm> with the contents
like the following:

 package Sah::SchemaV::My::Lib;

 our %Validators;
 our %Args_Validators;

 # for ["str*","len_between",[1,10]]
 $Validators{'12bb9471cf257c92a9028dcd9bfa2078c186fd32'} = sub {
     ... validator code ...
 };
 # for "uint*"
 $Validators{'3668dd65767787facd64512dd40026ab6f7090d9'} = sub {
     ... validator code ...
 };

 $Args_Validators{func1} = {
    arg1 => $Validators{'12bb9471cf257c92a9028dcd9bfa2078c186fd32'},
    arg2 => $Validators{'12bb9471cf257c92a9028dcd9bfa2078c186fd32'},
 };

=for Pod::Coverage .+

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Dist-Zilla-Plugin-Rinci-GenSchemaV>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-Dist-Zilla-Plugin-Rinci-GenSchemaV>.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Dist-Zilla-Plugin-Rinci-GenSchemaV>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=head1 SEE ALSO

=head1 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2019 by perlancar@cpan.org.

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
