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

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 we need a way of getting inline pod from installed modules too
     ($*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~ module-names($modulename).list);
    DEBUG and warn :@candidates.perl;
    my $m = @candidates.first: *.IO.f;
    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) {
    my $pager = %*ENV<PAGER> // ($*DISTRO.name eq 'mswin32' ?? 'more' !! 'less');
    my $which-fmt = qq:x{which fmt}.chomp;
    my $fmt-string = $which-fmt.IO.e ?? "| $which-fmt -w 80 " !! "";
    if not open($path).lines.grep( /^'=' | '#|' | '#='/ )  {
        say "No Pod found in $path";
        return;
    }
    if $section.defined {
        %*ENV<PERL6_POD_HEADING> = $section;
        my $i = findbin() ~ '../lib';
        say "launching '$*EXECUTABLE-NAME -I$i --doc=SectionFilter $path $fmt-string | $pager'" if DEBUG;
        shell "$*EXECUTABLE-NAME -I$i --doc=SectionFilter $path $fmt-string | $pager";
    }
    else {
        shell "$*EXECUTABLE-NAME --doc $path $fmt-string | $pager";
    }
}

multi sub MAIN() {
    my $me = $PROGRAM-NAME.IO.basename;

    say 'What documentation do you want to read?';
    say "Examples: $me Type::Str";
    say "          $me Type::Str.split";

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

multi sub MAIN($docee) {
    return MAIN($docee, :f) if defined $docee.index('.') ;
    if INDEX.IO ~~ :e {
        my %data = EVALFILE INDEX;
        if %data{$docee} {
            my $newdoc = %data{$docee}[0][0];
            return MAIN($newdoc);
        }
    }
    show-docs(locate-module($docee));
}

multi sub MAIN($docee, Bool :$f!) {
    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));
        } 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));
    }
}

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' / and not $^v ~~ / 'Cool' $ / });
            @types = [gather @types.deepmap(*.take)].unique.list;
            %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}>>.subst(/^'Type::'/, '');
        }

        # '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;
}

# vim: expandtab shiftwidth=4 ft=perl6
