#!/usr/bin/env perl6
use MONKEY-SEE-NO-EVAL; # until we have a better serialisation
use JSON::Fast;

my $PROGRAM-NAME = "p6doc";

# die with printing a backtrace
my class X::P6doc is Exception {
    has $.message;
    multi method gist(X::P6doc:D:) {
        self.message;
    }
}

constant DEBUG      = %*ENV<P6DOC_DEBUG>;
constant INTERACT   = %*ENV<P6DOC_INTERACT>;

sub findbin() returns Str {
    IO::Path.new($*PROGRAM-NAME).parent ~ '/';
}

constant INDEX = findbin() ~ 'index.data';

sub search-paths() returns Seq {
    (('.', |$*REPO.repo-chain())>>.Str X~ </doc/>).grep: *.IO.d
}

sub module-names(Str $modulename) returns Seq {
    $modulename.split('::').join('/') X~ <.pm .pm6 .pod .pod6>;
}

sub locate-module(Str $modulename) {
    my @candidates = search-paths() X~ </ Type/ Language/> X~ module-names($modulename).list;
    DEBUG and warn :@candidates.perl;
    my $m = @candidates.first: *.IO.f;

    unless $m.defined {
        # not "core" pod now try for panda or zef installed module
        $m = locate-curli-module($modulename);
    }

    unless $m.defined {
        my $message = join "\n",
            "Cannot locate $modulename in any of the following paths:",
            search-paths.map({"  $_"});
        X::P6doc.new(:$message).throw;
    }

    return $m;
}

sub show-docs(Str $path, :$section, :$no-pager) {
    my $pager;
    $pager = %*ENV<PAGER> // ($*DISTRO.is-win ?? 'more' !! 'less') unless $no-pager;
    if not open($path).lines.grep( /^'=' | '#|' | '#='/ ) {
        say "No Pod found in $path";
        return;
    }
    my $doc-command-str = $*EXECUTABLE-NAME;
    if $section.defined {
        %*ENV<PERL6_POD_HEADING> = $section;
        my $i = findbin() ~ '../lib';
        $doc-command-str ~= " -I$i --doc=SectionFilter"
    } else {
        $doc-command-str ~= " --doc"
    }
    $doc-command-str ~= " $path ";
    $doc-command-str ~= " | $pager" if $pager;
    say "launching '$doc-command-str'" if DEBUG;
    shell $doc-command-str;
}

multi sub MAIN() {

    say 'What documentation do you want to read?';
    say "Examples: $PROGRAM-NAME Str";
    say "          $PROGRAM-NAME Str.split";
    say "          $PROGRAM-NAME faq";

    say "\nYou can list some top level documents:";
    say "          $PROGRAM-NAME -l";

    say "\nYou can also look up specific method/routine definitions:";
    say "          $PROGRAM-NAME -f push";

    say "\nYou can bypass the pager and print straight to stdout:";
    say "          $PROGRAM-NAME -n Str"
}

multi sub MAIN($docee, Bool :$n) {
    return MAIN($docee, :f, :$n) if defined $docee.index('.');
    show-docs(locate-module($docee), :no-pager($n));
}

multi sub MAIN(Bool :$l!) {
    my @paths = search-paths() X~ <Type/ Language/>;
    my @modules;
    for @paths -> $dir {
        for dir($dir).sort -> $file {
            @modules.push: $file.basename.subst( '.'~$file.extension,'') if $file.IO.f;
        }
    }
    @modules.append: list-installed().map(*.name);
    .say for @modules.unique.sort;
}

multi sub MAIN($docee, Bool :$f!, Bool :$n) {
    my ($package, $method) = $docee.split('.');
    if ! $method {
        my %hits;
        if INDEX.IO ~~ :e {

            my %data = EVALFILE INDEX;

            my $final-docee = disambiguate-f-search($docee, %data);
            ($package, $method) = $final-docee.split('.');

            my $m = locate-module($package);
            show-docs($m, :section($method), :no-pager($n));
        } else {
            say 'In order to use unqualified sub and method names like "p6doc -f say"';
            say 'you will need to run "p6doc-index build" to build index.data.';
            say 'Otherwise use "p6doc -f Type::Str.split" instead of "p6doc -f split" for now.';
            exit 2;
        }
    } else {
        my $m = locate-module($package);
        show-docs($m, :section($method), :no-pager($n));
    }
}

multi sub MAIN(Str $file where $file.IO ~~ :e, Bool :$n) {
    show-docs($file, :no-pager($n));
}

sub disambiguate-f-search($docee, %data) {
    my %found;

    for <routine method> -> $pref {
        my $ndocee = $pref ~ " " ~ $docee;

        if %data{$ndocee} {
            my @types = %data{$ndocee}.values>>.Str.grep({ $^v ~~ /^ 'Type' / });
            @types = [gather @types.deepmap(*.take)].unique.list;
            @types.=grep({!/$pref/});
            %found{$ndocee}.push: @types X~ "." ~ $docee;
        }
    }

    my $final-docee;
    my $total-found = %found.values.map( *.elems ).sum;
    if ! $total-found {
        say "No documentation found for a routine named '$docee'";
        exit 2;
    } elsif $total-found == 1 {
        $final-docee = %found.values[0];
    } else {
        say "We have multiple matches for '$docee'\n";

        my %options;
        for %found.keys -> $key {
            %options{$key}.push: %found{$key};
        }
        my @opts = %options.values.map({ @($^a) });

        # 's' => Type::Supply.grep, ... | and we specifically want the %found values,
        #                               | not the presentation-versions in %options
        if INTERACT {
            my $total-elems = %found.values.map( +* ).sum;
            if +%found.keys < $total-elems {
                my @prefixes = (1..$total-elems) X~ ") ";
                say "\t" ~ ( @prefixes Z~ @opts ).join("\n\t") ~ "\n";
            } else {
                say "\t" ~ @opts.join("\n\t") ~ "\n";
            }
            $final-docee = prompt-with-options(%options, %found);
        } else {
            say "\t" ~ @opts.join("\n\t") ~ "\n";
            exit 1;
        }
    }

    return $final-docee;
}

sub prompt-with-options(%options, %found) {
    my $final-docee;

    my %prefixes = do for %options.kv -> $k,@o { @o.map(*.comb[0].lc) X=> %found{$k} };

    if %prefixes.values.grep( -> @o { +@o > 1 } ) {
        my (%indexes,$base-idx);
        $base-idx = 0;
        for %options.kv -> $k,@o {
            %indexes.push: @o>>.map({ ++$base-idx }) Z=> @(%found{$k});
        }
        %prefixes = %indexes;
    }

    my $prompt-text = "Narrow your choice? ({ %prefixes.keys.sort.join(', ') }, or !{ '/' ~ 'q' if !%prefixes<q> } to quit): ";

    while prompt($prompt-text).words -> $word {
        if $word  ~~ '!' or ($word ~~ 'q' and !%prefixes<q>) {
            exit 1;
        } elsif $word ~~ /:i $<choice> = [ @(%prefixes.keys) ] / {
            $final-docee = %prefixes{ $<choice>.lc };
            last;
        } else {
            say "$word doesn't seem to apply here.\n";
            next;
        }
    }

    return $final-docee;
}

sub locate-curli-module($module) {
    my $cu = $*REPO.need(CompUnit::DependencySpecification.new(:short-name($module)));
    return ~ $cu.repo.prefix.child('sources/' ~ $cu.repo-id);
}

# see: Zef::Client.list-installed()
# Eventually replace with CURI.installed()
# https://github.com/rakudo/rakudo/blob/8d0fa6616bab6436eab870b512056afdf5880e08/src/core/CompUnit/Repository/Installable.pm#L21
sub list-installed() {
    my @curs       = $*REPO.repo-chain.grep(*.?prefix.?e);
    my @repo-dirs  = @curs>>.prefix;
    my @dist-dirs  = |@repo-dirs.map(*.child('dist')).grep(*.e);
    my @dist-files = |@dist-dirs.map(*.IO.dir.grep(*.IO.f).Slip);

    my $dists := gather for @dist-files -> $file {
        if try { Distribution.new( |%(from-json($file.IO.slurp)) ) } -> $dist {
            my $cur = @curs.first: {.prefix eq $file.parent.parent}
            my $dist-with-prefix = $dist but role :: { has $.repo-prefix = $cur.prefix };
            take $dist-with-prefix;
        }
    }
}

# vim: expandtab shiftwidth=4 ft=perl6
