package    # hide from PAUSE
    ModuleGenerator;

use v5.22;

use strict;
use warnings;
use feature qw( postderef signatures );
use namespace::autoclean;
use autodie;

use Data::Dumper::Concise qw( Dumper );
use JSON::MaybeXS qw( decode_json );
use List::AllUtils qw( max uniq );
use Locale::Codes::Language
    qw( language_code2code LOCALE_LANG_ALPHA_2 LOCALE_LANG_ALPHA_3 );
use ModuleGenerator::Locale;
use Parse::PMFile;
use Path::Iterator::Rule;
use Path::Tiny qw( path );
use Scalar::Util qw( reftype );
use Specio::Declare;
use Specio::Library::Builtins;
use Specio::Library::Path::Tiny;
use Specio::Subs qw( Specio::Library::Builtins );
use Text::Template;

use Moose;

## no critic (TestingAndDebugging::ProhibitNoWarnings)
no warnings qw( experimental::postderef experimental::signatures );
## use critic

with 'MooseX::Getopt::Dashes';

our $VERSION = '0.10';

has _only_locales => (
    traits   => ['Array'],
    is       => 'ro',
    isa      => t( 'ArrayRef', of => t('Str') ),
    init_arg => 'locales',
    default => sub { [] },
    handles => {
        _has_only_locales => 'count',
    },
    documentation => 'If specified, only these locales will be built.',
);

has _autogen_warning => (
    is      => 'ro',
    isa     => t('Str'),
    lazy    => 1,
    builder => '_build_autogen_warning',
);

has _generator_script => (
    is      => 'ro',
    isa     => t('File'),
    lazy    => 1,
    builder => '_build_generator_script',
);

has _source_data_root => (
    is      => 'ro',
    isa     => t('Dir'),
    lazy    => 1,
    builder => '_build_source_data_root',
);

has _locale_codes => (
    is      => 'ro',
    isa     => t( 'ArrayRef', of => t('Str') ),
    lazy    => 1,
    builder => '_build_locale_codes',
);

has _locales => (
    is   => 'ro',
    isa  => t( 'ArrayRef', of => object_isa_type('ModuleGenerator::Locale') ),
    lazy => 1,
    builder => '_build_locales',
);

sub run ($self) {
    $self->_clean_old_data;
    $self->_locales;
    $self->_write_data_files;
    $self->_write_catalog_pm;
    $self->_write_pod_files;

    return 0;
}

sub _clean_old_data ($self) {
    my $pir  = Path::Iterator::Rule->new;
    my $iter = $pir->file->name(qr/\.pod$/)->iter('lib');
    while ( my $path = $iter->() ) {
        $path = path($path);
        ## no critic (InputOutput::RequireCheckedSyscalls)
        say 'Removing ', $path->basename;
        $path->remove;
    }
}

sub _build_locales ($self) {
    my @locales;
    for my $code ( $self->_locale_codes->@* ) {
        my $locale = ModuleGenerator::Locale->instance(
            code             => $code,
            source_data_root => $self->_source_data_root,
        );

        ## no critic (InputOutput::RequireCheckedSyscalls)
        say $locale->code . q{ - } . $locale->en_name;
        say $_ for $locale->source_files;
        print "\n";
        ## use critic

        push @locales, $locale;
    }

    return \@locales;
}

sub _write_data_files ($self) {
    my %raw_locales = $self->_write_data_pm;

    for my $code ( sort keys %raw_locales ) {
        my $dumped = $self->_dump_with_unicode( $raw_locales{$code} );
        my $file = path( 'share', $code . '.pl' );
        ## no critic (InputOutput::RequireCheckedSyscalls)
        say "Generating $file";
        $file->spew($dumped);
    }

    return;
}

sub _write_data_pm ($self) {
    my %codes;
    my %names;
    my %native_names;
    my %raw_locales;
    for my $locale ( $self->_locales->@* ) {
        $codes{ $locale->code }               = 1;
        $names{ $locale->en_name }            = $locale->code;
        $native_names{ $locale->native_name } = $locale->code;
        $raw_locales{ $locale->code }         = $locale->data_hash;
    }

    my $data_pm_file = path(qw( lib DateTime Locale Data.pm ));
    ## no critic (InputOutput::RequireCheckedSyscalls)
    say "Generating $data_pm_file";
    ## use critic
    my $data_pm = $data_pm_file->slurp_utf8;

    $self->_insert_autogen_warning( \$data_pm );

    $self->_insert_var_in_code(
        'CLDRVersion',
        $self->_locales->[0]->version, 1, \$data_pm
    );

    $self->_insert_var_in_code( 'Codes',       \%codes,        1, \$data_pm );
    $self->_insert_var_in_code( 'Names',       \%names,        1, \$data_pm );
    $self->_insert_var_in_code( 'NativeNames', \%native_names, 1, \$data_pm );

    $self->_insert_var_in_code(
        'ISO639Aliases',
        $self->_iso_639_aliases, 1, \$data_pm
    );

    # These are some of the world's top languages by speakers plus a few
    # locales where I think there are lots of Perl people.
    my %preload = map { $_ => delete $raw_locales{$_} }
        qw( ar en en-CA en-US es fr-FR hi ja-JP pt-BR zh-Hans-CN zh-Hant-TW );

    $self->_insert_var_in_code( 'LocaleData', \%preload, 0, \$data_pm );

    $data_pm_file->spew_utf8($data_pm);

    return %raw_locales;
}

sub _iso_639_aliases ($self) {
    my %aliases;
    for my $locale ( $self->_locales->@* ) {
        next if length $locale->language_code > 2;

        my $three = language_code2code(
            $locale->language_code,
            LOCALE_LANG_ALPHA_2, LOCALE_LANG_ALPHA_3
        );

        my $full_three_code = join '-',
            grep {defined} (
            $three,
            $locale->script_code,
            $locale->territory_code,
            $locale->variant_code
            );

        $aliases{$full_three_code} = $locale->code;
    }
    return \%aliases;
}

sub _write_catalog_pm ($self) {
    my $catalog_pm_file = path(qw( lib DateTime Locale Catalog.pm ));
    ## no critic (InputOutput::RequireCheckedSyscalls)
    say "Generating $catalog_pm_file";
    ## use critic
    my $catalog_pm = $catalog_pm_file->slurp_utf8;

    my $max_code = max map { length $_->code } $self->_locales->@*;
    $max_code += 3;
    my $max_en_name = max map { length $_->en_name } $self->_locales->@*;
    $max_en_name += 3;
    my $max_native_name
        = max map { length $_->native_name } $self->_locales->@*;
    $max_native_name += 3;

    my $locale_list = sprintf(
        " %-${max_code}s%-${max_en_name}s%-${max_native_name}s\n",
        'Locale code', 'Locale name (in English)', 'Native locale name'
    );
    $locale_list
        .= q{ } . '=' x ( $max_code + $max_en_name + $max_native_name );
    $locale_list .= "\n";

    for my $locale ( sort { $a->code cmp $b->code } $self->_locales->@* ) {
        $locale_list .= sprintf(
            " %-${max_code}s%-${max_en_name}s%-${max_native_name}s\n",
            $locale->code, $locale->en_name, $locale->native_name,
        );
    }
    $locale_list .= "\n";

    $locale_list =~ s/ +$//mg;

    $catalog_pm =~ s/(^=for :locales\n\n).+^(?==)/$1$locale_list/ms
        or die 'locale list subst failed';

    $catalog_pm_file->spew_utf8($catalog_pm);
}

sub _insert_var_in_code ( $self, $name, $value, $public, $code ) {
    my $sigil
        = !ref $value              ? '$'
        : reftype $value eq 'HASH' ? '%'
        :                            '@';

    my $safe;
    if ( ref $value ) {
        $safe = $self->_dump_with_unicode($value);
        $safe =~ s/^[\{\[]/(/;
        $safe =~ s/[\}\]]\n$/)/;
    }
    else {
        $safe = $value = is_Num($value) ? $value : B::perlstring($value);
    }

    my $declarator = $public ? 'our' : 'my';
    ${$code} =~ s/
        (\#<<<\n
         \#\#\#\Q :start $name:\E\n)
        .*
        (\#\#\#\Q :end $name:\E\n
         \#>>>\n)
    /$1$declarator $sigil$name = $safe;\n$2/xs
        or die "inserting $name failed";

    return;
}

# Data::Dumper dumps all Unicode characters using Perl's \x{feedad0g}
# syntax. If the character is in the 0x80-0xFF range, then Perl will not treat
# this as a UTF-8 char when it sees it (either at compile or eval time). We
# force it to use UTF-8 by replacing \x{feedad0g} with \N{U+feedad0g}, which
# is always interpreted as UTF-8.
sub _dump_with_unicode ( $self, $val ) {
    my $dumped = Dumper($val);
    $dumped =~ s/\\x\{([^}]+)\}/$self->_unicode_char_for($1)/eg;
    return $dumped;
}

sub _unicode_char_for ( $, $hex ) {
    ## no critic (BuiltinFunctions::ProhibitStringyEval)
    my $num = eval '0x' . $hex;
    die $@ if $@;
    return '\N{U+' . sprintf( '%04x', $num ) . '}';
}

sub _insert_autogen_warning ( $self, $code ) {
    ${$code} =~ s/(?:^###+$).+(?:^###+$)\n+//ms;
    ${$code} =~ s/^/$self->_autogen_warning/e;
    return;
}

sub _build_autogen_warning ($self) {
    my $script = $self->_generator_script->basename;

    return <<"EOF";
###########################################################################
#
# This file is partially auto-generated by the DateTime::Locale generator
# tools (v$VERSION). This code generator comes with the DateTime::Locale
# distribution in the tools/ directory, and is called $script.
#
# This file was generated from the CLDR JSON locale data. See the LICENSE.cldr
# file included in this distribution for license details.
#
# Do not edit this file directly unless you are sure the part you are editing
# is not created by the generator.
#
###########################################################################

EOF
}

sub _write_pod_files ($self) {
    my $template = Text::Template->new(
        TYPE   => 'FILE',
        SOURCE => path(qw( tools templates locale.pod ))->stringify,
    ) or die $Text::Template::ERROR;

    use lib 'lib';
    require Test::File::ShareDir::Dist;
    Test::File::ShareDir::Dist->import( { 'DateTime-Locale' => 'share' } );
    require DateTime;
    require DateTime::Locale;

    my @example_dts = (
        DateTime->new(
            year      => 2008,
            month     => 2,
            day       => 5,
            hour      => 18,
            minute    => 30,
            second    => 30,
            time_zone => 'UTC',
        ),
        DateTime->new(
            year      => 1995,
            month     => 12,
            day       => 22,
            hour      => 9,
            minute    => 5,
            second    => 2,
            time_zone => 'UTC',
        ),
        DateTime->new(
            year      => -10,
            month     => 9,
            day       => 15,
            hour      => 4,
            minute    => 44,
            second    => 23,
            time_zone => 'UTC',
        ),
    );

    for my $code ( DateTime::Locale->codes ) {
        my $underscore = $code =~ s/-/_/gr;

        my $pod_file
            = path( qw( lib DateTime Locale ), $underscore . '.pod' );
        ## no critic (InputOutput::RequireCheckedSyscalls)
        say "Generating $pod_file";
        ## use critic

        my $locale = DateTime::Locale->load($code)
            or die "Cannot load $code";

        my $name   = $locale->name;
        my $filled = $template->fill_in(
            HASH => {
                autogen_warning => $self->_autogen_warning,
                name            => 'DateTime::Locale::' . $underscore,
                description =>
                    "Locale data examples for the $name ($code) locale",
                example_dts => \@example_dts,
                locale      => \$locale,
            },
        ) or die $Text::Template::ERROR;

        $pod_file->spew_utf8($filled);
    }

    return;
}

sub _build_generator_script {
    return path($0);
}

sub _build_source_data_root ($self) {
    return $self->_generator_script->parent->parent->child('source-data');
}

sub _build_locale_codes ($self) {

    # We need to have en-US available so we can build a DateTime.pm object.
    return [ uniq( 'en-US', @{ $self->_only_locales } ) ]
        if $self->_has_only_locales;

    my $avail = decode_json(
        $self->_source_data_root->child(
            qw( cldr-core availableLocales.json ))->slurp_raw
    );

    my $default
        = decode_json(
        $self->_source_data_root->child(qw( cldr-core defaultContent.json ))
            ->slurp_raw );

    return [
        $avail->{availableLocales}{full}->@*,
        $default->{defaultContent}->@*
    ];
}

__PACKAGE__->meta->make_immutable;

1;