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

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 {
    $*PROGRAM-NAME.subst(rx{<-[/\\]>+$}, '');
}

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

sub tempfile() {
    my $tempfile = $*TMPDIR.Str;
    $tempfile ~= '/';
    $tempfile ~= join '', ('a'..'z', 0..9).roll(5);
    $tempfile ~= '.tmp';
    nextsame if $tempfile.IO.e;
    return $tempfile;
}

sub search-paths() {
    # XXX 
     ($*REPO.repo-chain()>>.Str X~ </doc/>).grep: *.IO.d
}

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

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 installed module XXX not zef
        $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.Str.subst('.pod','') if $file.IO.f;
        }
    }
    @modules.append: get-panda-modules(); 
    .say for @modules.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 );
    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};
        }

        # 's' => Type::Supply.grep, ... | and we specifically want the %found values,
        #                               | not the presentation-versions in %options
        if INTERACT {
            my $idx = 0;
            my $total-elems = [+] %found.values.map({ +@^o });
            if +%found.keys < $total-elems {
                my @prefixes = (1..$total-elems) X~ ") ";
                say "\t" ~ ( @prefixes Z~ %options.values.map({ @($^a) }) ).join("\n\t") ~ "\n";
            } else {
                say "\t" ~ %options.values.map({ @($^a) }).join("\n\t") ~ "\n";
            }
            $final-docee = prompt-with-options( %options, %found );
        } else {
            say "\t" ~ %options.values.map({ @($^a) }).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.distribution.provides{$module}.values[0]<file>).Str;
}

sub get-panda-modules {
    my $state = Panda::Installer.new.default-prefix() ~ '/panda/state';
    my @modules;
    for $state.IO.lines -> $line {
        my (Any, $json ) = $line.split(/'installed '|'installed-dep '/);
        my $state = from-json $json;
        @modules.append: $state<provides>.keys.list;
    }

    return @modules;
}

# vim: expandtab shiftwidth=4 ft=perl6
