package Complete::Util;

our $DATE = '2015-11-29'; # DATE
our $VERSION = '0.40'; # VERSION

use 5.010001;
use strict;
use warnings;

use Complete::Setting;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
                       hashify_answer
                       arrayify_answer
                       combine_answers
                       complete_array_elem
                       complete_hash_key
               );

our %SPEC;

$SPEC{':package'} = {
    v => 1.1,
    summary => 'General completion routine',
};

$SPEC{hashify_answer} = {
    v => 1.1,
    summary => 'Make sure we return completion answer in hash form',
    description => <<'_',

This function accepts a hash or an array. If it receives an array, will convert
the array into `{words=>$ary}' first to make sure the completion answer is in
hash form.

Then will add keys from `meta` to the hash.

_
    args => {
        arg => {
            summary => '',
            schema  => ['any*' => of => ['array*','hash*']],
            req => 1,
            pos => 0,
        },
        meta => {
            summary => 'Metadata (extra keys) for the hash',
            schema  => 'hash*',
            pos => 1,
        },
    },
    result_naked => 1,
    result => {
        schema => 'hash*',
    },
};
sub hashify_answer {
    my $ans = shift;
    if (ref($ans) ne 'HASH') {
        $ans = {words=>$ans};
    }
    if (@_) {
        my $meta = shift;
        for (keys %$meta) {
            $ans->{$_} = $meta->{$_};
        }
    }
    $ans;
}

$SPEC{arrayify_answer} = {
    v => 1.1,
    summary => 'Make sure we return completion answer in array form',
    description => <<'_',

This is the reverse of `hashify_answer`. It accepts a hash or an array. If it
receives a hash, will return its `words` key.

_
    args => {
        arg => {
            summary => '',
            schema  => ['any*' => of => ['array*','hash*']],
            req => 1,
            pos => 0,
        },
    },
    result_naked => 1,
    result => {
        schema => 'array*',
    },
};
sub arrayify_answer {
    my $ans = shift;
    if (ref($ans) eq 'HASH') {
        $ans = $ans->{words};
    }
    $ans;
}

sub __min(@) {
    my $m = $_[0];
    for (@_) {
        $m = $_ if $_ < $m;
    }
    $m;
}

# straight copy of Wikipedia's "Levenshtein Distance"
sub __editdist {
    my @a = split //, shift;
    my @b = split //, shift;

    # There is an extra row and column in the matrix. This is the distance from
    # the empty string to a substring of the target.
    my @d;
    $d[$_][0] = $_ for 0 .. @a;
    $d[0][$_] = $_ for 0 .. @b;

    for my $i (1 .. @a) {
        for my $j (1 .. @b) {
            $d[$i][$j] = (
                $a[$i-1] eq $b[$j-1]
                    ? $d[$i-1][$j-1]
                    : 1 + __min(
                        $d[$i-1][$j],
                        $d[$i][$j-1],
                        $d[$i-1][$j-1]
                    )
                );
        }
    }

    $d[@a][@b];
}

$SPEC{complete_array_elem} = {
    v => 1.1,
    summary => 'Complete from array',
    description => <<'_',

Will sort the resulting completion list, so you don't have to presort the array.

_
    args => {
        word      => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
        array     => { schema=>['array*'=>{of=>'str*'}], req=>1 },
        ci        => {
            schema=>['bool'],
        },
        exclude   => { schema=>['array*'] },
        word_mode => {
            summary => 'Whether to enable word-mode matching',
            schema=>['bool'],
            description => <<'_',

See `Complete::Setting` for more detail on word-mode matching.

_
        },
        fuzzy     => {
            summary => 'Set fuzziness for fuzzy matching',
            schema=>['int*', min=>0],
            description => <<'_',

See `Complete::Setting` for more detail on fuzzy matching.

_
        },
        map_case  => {
            summary => 'Treat _ (underscore) and - (dash) as the same',
            schema  => ['bool'],
        },
    },
    result_naked => 1,
    result => {
        schema => 'array',
    },
};
sub complete_array_elem {
    state $code_editdist;

    my %args  = @_;

    my $array     = $args{array} or die "Please specify array";
    my $word      = $args{word} // "";
    my $ci        = $args{ci} // $Complete::Setting::OPT_CI;
    my $word_mode = $args{word_mode} // $Complete::Setting::OPT_WORD_MODE;
    my $fuzzy     = $args{fuzzy} // $Complete::Setting::OPT_FUZZY;
    my $map_case  = $args{map_case} // $Complete::Setting::OPT_MAP_CASE;

    return [] unless @$array;

    # normalize
    my $wordn = $ci ? uc($word) : $word; $wordn =~ s/_/-/g if $map_case;

    my @words;
    my @arrayn;
    for my $el (@$array) {
        my $eln = $ci ? uc($el) : $el; $eln =~ s/_/-/g if $map_case;
        push @arrayn, $eln; # so we don't have to calculate again
        next unless 0==index($eln, $wordn);
        push @words, $el;
    }

    {
        last unless $word_mode && !@words;
        my @split_wordn = $wordn =~ /(\w+)/g;
        unshift @split_wordn, '' if $wordn =~ /\A\W/;
        last unless @split_wordn > 1;
        my $re = '\A';
        for my $i (0..$#split_wordn) {
            $re .= '(?:\W+\w+)*\W+' if $i;
            $re .= quotemeta($split_wordn[$i]).'\w*';
        }
        #say "D:re=$re";
        $re = qr/$re/;

        for my $i (0..$#{$array}) {
            next unless $arrayn[$i] =~ $re;
            push @words, $array->[$i];
        }
    }

    if ($fuzzy && !@words) {
        $code_editdist //= do {
            if (eval { require Text::Levenshtein::XS; 1 }) {
                \&Text::Levenshtein::XS::distance;
            } else {
                \&__editdist;
            }
        };

        my $factor = 1.3;
        my $x = -1;
        my $y = 1;

        my %editdists;
      ELEM:
        for my $i (0..$#{$array}) {
            my $eln = $arrayn[$i];

            for my $l (length($wordn)-$y .. length($wordn)+$y) {
                next if $l <= 0;
                my $chopped = substr($eln, 0, $l);
                my $d;
                unless (defined $editdists{$chopped}) {
                    $d = $code_editdist->($wordn, $chopped);
                    $editdists{$chopped} = $d;
                } else {
                    $d = $editdists{$chopped};
                }
                my $maxd = __min(
                    __min(length($chopped), length($word))/$factor,
                    $fuzzy,
                );
                #say "D: d(".($ci ? $wordu:$word).",$chopped)=$d (maxd=$maxd)";
                next unless $d <= $maxd;
                push @words, $array->[$i];
                next ELEM;
            }
        }
    }

    if ($args{exclude}) {
        my $exclude = $ci ? [map {uc} @{ $args{exclude} }] : $args{exclude};
        @words = grep {
            my $w = $_;
            !(grep {($ci ? uc($w) : $w) eq $_} @$exclude);
        } @words;
    }

    return $ci ? [sort {lc($a) cmp lc($b)} @words] : [sort @words];
}

$SPEC{complete_hash_key} = {
    v => 1.1,
    summary => 'Complete from hash keys',
    args => {
        word      => { schema=>[str=>{default=>''}], pos=>0, req=>1 },
        hash      => { schema=>['hash*'=>{}], req=>1 },
        ci        => { schema=>['bool'] },
        word_mode => { schema=>['bool'] },
        fuzzy     => { schema=>['int*', min=>0] },
        map_case  => { schema=>['bool'] },
    },
    result_naked => 1,
    result => {
        schema => 'array',
    },
};
sub complete_hash_key {
    my %args  = @_;
    my $hash      = $args{hash} or die "Please specify hash";
    my $word      = $args{word} // "";
    my $ci        = $args{ci} // $Complete::Setting::OPT_CI;
    my $word_mode = $args{word_mode} // $Complete::Setting::OPT_WORD_MODE;
    my $fuzzy     = $args{fuzzy} // $Complete::Setting::OPT_FUZZY;
    my $map_case  = $args{map_case} // $Complete::Setting::OPT_MAP_CASE;

    my @array = $ci ?
        (sort {uc($a) cmp uc($b)} keys %$hash) : (sort keys %$hash);
    complete_array_elem(
        word=>$word, array=>\@array,
        ci=>$ci, word_mode=>$word_mode, fuzzy=>$fuzzy, map_case=>$map_case,
    );
}

$SPEC{combine_answers} = {
    v => 1.1,
    summary => 'Given two or more answers, combine them into one',
    description => <<'_',

This function is useful if you want to provide a completion answer that is
gathered from multiple sources. For example, say you are providing completion
for the Perl tool `cpanm`, which accepts a filename (a tarball like `*.tar.gz`),
a directory, or a module name. You can do something like this:

    combine_answers(
        complete_file(word=>$word, ci=>1),
        complete_module(word=>$word, ci=>1),
    );

If a completion answer has a metadata `final` set to true, then that answer is
used as the final answer without any combining with the other answers.

_
    args => {
        answers => {
            schema => [
                'array*' => {
                    of => ['any*', of=>['hash*','array*']], # XXX answer_t
                    min_len => 1,
                },
            ],
            req => 1,
            pos => 0,
            greedy => 1,
        },
    },
    args_as => 'array',
    result_naked => 1,
    result => {
        schema => 'hash*',
        description => <<'_',

Return a combined completion answer. Words from each input answer will be
combined, order preserved and duplicates removed. The other keys from each
answer will be merged.

_
    },
};
sub combine_answers {
    require List::Util;

    return undef unless @_;
    return $_[0] if @_ < 2;

    my $final = {words=>[]};
    my $encounter_hash;
    my $add_words = sub {
        my $words = shift;
        for my $entry (@$words) {
            push @{ $final->{words} }, $entry
                unless List::Util::first(
                    sub {
                        (ref($entry) ? $entry->{word} : $entry)
                            eq
                                (ref($_) ? $_->{word} : $_)
                            }, @{ $final->{words} }
                        );
        }
    };

  ANSWER:
    for my $ans (@_) {
        if (ref($ans) eq 'ARRAY') {
            $add_words->($ans);
        } elsif (ref($ans) eq 'HASH') {
            $encounter_hash++;

            if ($ans->{final}) {
                $final = $ans;
                last ANSWER;
            }

            $add_words->($ans->{words} // []);
            for (keys %$ans) {
                if ($_ eq 'words') {
                    next;
                } elsif ($_ eq 'static') {
                    if (exists $final->{$_}) {
                        $final->{$_} &&= $ans->{$_};
                    } else {
                        $final->{$_} = $ans->{$_};
                    }
                } else {
                    $final->{$_} = $ans->{$_};
                }
            }
        }
    }

    # re-sort final words
    if ($final->{words}) {
        $final->{words} = [
            sort {
                (ref($a) ? $a->{word} : $a) cmp
                    (ref($b) ? $b->{word} : $b);
            }
                @{ $final->{words} }];
    }

    $encounter_hash ? $final : $final->{words};
}

1;
# ABSTRACT: General completion routine

__END__

=pod

=encoding UTF-8

=head1 NAME

Complete::Util - General completion routine

=head1 VERSION

This document describes version 0.40 of Complete::Util (from Perl distribution Complete-Util), released on 2015-11-29.

=head1 DESCRIPTION

=head1 FUNCTIONS


=head2 arrayify_answer(%args) -> array

Make sure we return completion answer in array form.

This is the reverse of C<hashify_answer>. It accepts a hash or an array. If it
receives a hash, will return its C<words> key.

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<arg>* => I<array|hash>

=back

Return value:  (array)


=head2 combine_answers($answers, ...) -> hash

Given two or more answers, combine them into one.

This function is useful if you want to provide a completion answer that is
gathered from multiple sources. For example, say you are providing completion
for the Perl tool C<cpanm>, which accepts a filename (a tarball like C<*.tar.gz>),
a directory, or a module name. You can do something like this:

 combine_answers(
     complete_file(word=>$word, ci=>1),
     complete_module(word=>$word, ci=>1),
 );

If a completion answer has a metadata C<final> set to true, then that answer is
used as the final answer without any combining with the other answers.

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<answers>* => I<array[hash|array]>

=back

Return value:  (hash)


Return a combined completion answer. Words from each input answer will be
combined, order preserved and duplicates removed. The other keys from each
answer will be merged.


=head2 complete_array_elem(%args) -> array

Complete from array.

Will sort the resulting completion list, so you don't have to presort the array.

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<array>* => I<array[str]>

=item * B<ci> => I<bool>

=item * B<exclude> => I<array>

=item * B<fuzzy> => I<int>

Set fuzziness for fuzzy matching.

See C<Complete::Setting> for more detail on fuzzy matching.

=item * B<map_case> => I<bool>

Treat _ (underscore) and - (dash) as the same.

=item * B<word>* => I<str> (default: "")

=item * B<word_mode> => I<bool>

Whether to enable word-mode matching.

See C<Complete::Setting> for more detail on word-mode matching.

=back

Return value:  (array)


=head2 complete_hash_key(%args) -> array

Complete from hash keys.

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<ci> => I<bool>

=item * B<fuzzy> => I<int>

=item * B<hash>* => I<hash>

=item * B<map_case> => I<bool>

=item * B<word>* => I<str> (default: "")

=item * B<word_mode> => I<bool>

=back

Return value:  (array)


=head2 hashify_answer(%args) -> hash

Make sure we return completion answer in hash form.

This function accepts a hash or an array. If it receives an array, will convert
the array into `{words=>$ary}' first to make sure the completion answer is in
hash form.

Then will add keys from C<meta> to the hash.

This function is not exported by default, but exportable.

Arguments ('*' denotes required arguments):

=over 4

=item * B<arg>* => I<array|hash>

=item * B<meta> => I<hash>

Metadata (extra keys) for the hash.

=back

Return value:  (hash)

=head1 SEE ALSO

L<Complete>

If you want to do bash tab completion with Perl, take a look at
L<Complete::Bash> or L<Getopt::Long::Complete> or L<Perinci::CmdLine>.

Other C<Complete::*> modules.

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Complete-Util>.

=head1 SOURCE

Source repository is at L<https://github.com/sharyanto/perl-SHARYANTO-Complete-Util>.

=head1 BUGS

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

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 AUTHOR

perlancar <perlancar@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 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
