### ----------------------------------------------------
### -- TAP
### -- Licenses: Artistic-2.0
### -- Authors: Leon Timmermans
### -- File: lib/TAP.rakumod
### ----------------------------------------------------
### -- Chunk 2 of 2
normalized = map { normalize-path($^dir, $cwd) }, flat @include-dirs, @!incdirs;
        @raku-lib.prepend(@normalized);
        %env<RAKULIB> = @raku-lib.join(',');
        TAP::Source::Proc.new(:$name, :command[ $!path, $name ], :$cwd, :%env);
    }
    method can-handle(IO::Path $name) {
        $name.extension eq 't6'|'rakutest' || $name.lines.head ~~ / ^ '#!' .* [ 'raku' | 'perl6' ] / ?? 0.8 !! 0.3;
    }
}

class SourceHandler::Exec does SourceHandler {
    has @.args;
    has SourceHandler::Priority $.priority = 1;
    method new (*@args) {
        self.bless(:@args);
    }
    method can-handle(IO::Path $name) {
        $!priority;
    }
    multi method make-source(::?CLASS:D: Str:D $name, IO:D() :$cwd = $*CWD, *%) {
        my $executable = ~$cwd.add($name);
        my @command = (|@!args, $executable);
        TAP::Source::Proc.new(:$name, :@command, :$cwd);
    }
}

class SourceHandler::File does SourceHandler {
    method can-handle(IO::Path $name) {
        $name.extension eq 'tap' ?? 1 !! 0;
    }
    multi method make-source(::?CLASS:D: Str:D $name, IO:D() :$cwd = $*CWD, *%) {
        my $filename = $cwd.add($name);
        TAP::Source::File.new(:$name, :$filename);
    }
}

class SourceHandlers {
    has TAP::SourceHandler @.handlers = ( SourceHandler::Raku.new, TAP::SourceHandler::File.new );
    multi method make-source(Str $path, IO:D(Str) :$cwd, *%args) {
        self.make-source(IO::Path.new($path, :CWD(~$cwd)), :$cwd, |%args);
    }
    multi method make-source(IO:D $path, IO:D(Str) :$cwd = $path.CWD, *%args) {
        @!handlers.max(*.can-handle($path)).make-source($path.relative($cwd), :$cwd, |%args)
    }
    multi method make-parser(Any:D $path, Promise :$bailout, Bool :$loose, :@handlers, Output :$output, Any:D :$err = 'stderr', *%args) {
        my $source = self.make-source($path, |%args);
        $source.parse(:$bailout, :$loose, :$output, :$err, :@handlers);
    }
    method COERCE($handlers) {
        self.new(:handlers($handlers.list));
    }
}

class Harness {
    # Backwards compatibility
    class SourceHandler {
        constant Raku = TAP::SourceHandler::Raku;
        constant Perl6 = TAP::SourceHandler::Raku; # will be removed later
        constant Exec = TAP::SourceHandler::Exec;
    }

    subset OutVal where any(IO::Handle:D, Supplier:D);

    has SourceHandlers() $.handlers = SourceHandlers.new;
    has IO::Handle $.handle = $*OUT;
    has OutVal $.output = $!handle;
    has Formatter::Volume $.volume = ?%*ENV<HARNESS_VERBOSE> ?? Verbose !! Normal;
    has Str %!env-options = (%*ENV<HARNESS_OPTIONS> // '').split(':').grep(*.chars).map: { / ^ (.) (.*) $ /; ~$0 => val(~$1) };
    has TAP::Reporter:U $.reporter-class;
    has Int:D $.jobs = %!env-options<j> // 1;
    has Bool:D $.timer = ?%*ENV<HARNESS_TIMER>;
    subset ErrValue where any(IO::Handle:D, Supplier, 'stderr', 'ignore', 'merge');
    has ErrValue $.err = 'stderr';
    has Bool:D $.ignore-exit = ?%*ENV<HARNESS_INGORE_EXIT>;
    has Bool:D $.trap = False;
    has Bool:D $.loose = $*PERL.compiler.version before 2017.09;
    has Bool $.color;

    class Run does Awaitable {
        has Promise $!promise handles <result get-await-handle> is built;
        has Promise $!bailout is built handles :kill<break>;
    }

    my &sigint = sub { signal(SIGINT) }

    my multi make-output(IO::Handle:D $handle) {
        return Output::Handle.new(:$handle);
    }
    my multi make-output(Supplier:D $supplier) {
        return Output::Supplier.new(:$supplier);
    }

    method !get-reporter(Output $output) {
        if $!reporter-class !=== Reporter {
            $!reporter-class;
        } elsif %!env-options<r> {
            my $classname = %!env-options<r>.subst('-', '::', :g);
            my $loaded = try ::($classname);
            return $loaded if $loaded !eqv Any;
            require ::($classname);
            ::($classname);
        } elsif $output.terminal && $!volume < Verbose {
            TAP::Reporter::Console;
        } else {
            TAP::Reporter::Text;
        }
    }

    method !get-color(Output $output) {
        with $!color {
            $!color;
        } orwith %!env-options<c> {
            True;
        } orwith %*ENV<HARNESS_COLOR> {
            ?%*ENV<HARNESS_COLOR>;
        } orwith %*ENV<NO_COLOR> {
            False;
        } else {
            state @safe-terminals = <xterm eterm vte konsole color>;
            $output.terminal && (%*ENV<TERM> // '') ~~ / @safe-terminals /;
        }
    }

    method run(*@names, IO(Str) :$cwd = $*CWD, OutVal :$out = $!output, ErrValue :$err = $!err, *%handler-args) {
        my $bailout = Promise.new;
        my $aggregator = TAP::Aggregator.new(:$!ignore-exit, :$bailout);
        my $output = make-output($out);
        my $formatter-class = self!get-color($output) ?? Formatter::Color !! Formatter::Text;
        my $formatter = $formatter-class.new(:@names, :$!volume, :$!timer, :$!ignore-exit);
        my $reporter-class = self!get-reporter($output);
        my $reporter = $reporter-class.new(:$output, :$formatter);

        my @working;
        my $promise = start {
            my $int = $!trap ?? sigint().tap({ $bailout.break(X::Interrupted.new); $int.close(); }) !! Tap;
            my $begin = now;
            try {
                for @names -> $name {
                    my $source = $!handlers.make-source($name, :$cwd, |%handler-args);
                    my $session = $reporter.open-test($source.name);
                    my @handlers = $session;
                    my $parser = $source.parse(:$bailout, :$!loose, :$err, :@handlers, :output($!volume === Verbose ?? $output !! Output));
                    @working.push({ :$parser, :$session, :done($parser.promise) });
                    next if @working < $!jobs;
                    await Promise.anyof(@working»<done>, $bailout);
                    reap-finished();
                    await $bailout if $bailout;
                }
                while @working {
                    await Promise.anyof(@working»<done>, $bailout);
                    reap-finished();
                    await $bailout if $bailout;
                }
                CATCH {
                    reap-finished();
                    @working».<parser>».kill;
                    when (X::Bailout | X::Interrupted) {
                    }
                }
            }
            $reporter.summarize($aggregator, now - $begin);
            $int.close if $int;
            $aggregator;
        }
        sub reap-finished() {
            my @new-working;
            for @working -> $current (:$done, :$parser, :$session) {
                if $done {
                    $aggregator.add-result($parser.result);
                    $session.close-test($parser.result);
                } else {
                    @new-working.push($current);
                }
            }
            @working = @new-working;
        }
        Run.new(:$promise, :$bailout);
    }
}

# ts=4 sw=4 et


