#!/usr/bin/env perl6

use nqp;
use Getopt::Advance;

my OptionSet $os .= new;

$os.push(
    'c=a',
    'c source file extension list.',
    value => [ "c", ]
);
$os.push(
    'h=a',
    'head file extension list.',
    value => [ "h", ]
);
$os.push(
    'cpp|=a',
    'cpp source file extension list.',
    value => Q :w ! C cpp c++ cxx hpp cc h++ hh hxx!
);
$os.push(
    'cfg|=a',
    'config file extension list.',
    value => Q :w ! ini config conf cfg xml !
);
$os.push(
    'm=a',
    'makefile extension list.',
    value => ["mk", ]
);
$os.push(
    'w=a',
    'match whole filename.',
    value => Q :w ! makefile Makefile !
);
$os.push(
    'a=a',
    'addition extension list.',
);
$os.push(
    'i=b',
    'enable ignore case mode.'
);
$os.append(
    'no|=a' => 'exclude file category.',
    'only|=s' => 'only search given category.',
    :radio
);
$os.push(
    'd|debug=b',
    'print debug message.'
);
my $id = $os.insert-pos(
    "directory",
    sub find-and-print-source($os, $dira) {
        my @stack = $dira.value;
        my (@t1, @t2);
        my ($debug, $ignore-case) = ($os<d>, $os<i>);

        @t1 = do {
            my @t;
            with $os<only> {
                fail "Not recognized category: {$_}." unless $_ (elem) < c h cpp cfg m a w >;
                @t := $_ eq "w" ?? [] !! ($os{$_} // []);
            } else {
                @t = [];
                for < c h cpp cfg m a > {
                    if $_ !(elem) @($os<no>) {
                        @t.append($os{$_} // []);
                    }
                }
            }
            @t = @t>>.lc if $ignore-case;
            flat( @t Z, (True xx +@t));
        };
        @t2 = do {
            my @t;
            @t = ($os.get('only').has-value && $os<only> ne "w") ?? [] !! (
                ("w" (elem) @($os<no>)) ?? [] !! ($os<w> // [])
            );
            @t = @t>>.lc if $ignore-case;
            flat( @t Z, (True xx +@t));
        };
        my %ext := Map.new(@t1);
        my %whole := Map.new(@t2);

        note "GET ALL EXT => ", %ext if $debug;

        my $supplier = Supplier.new;

        my $p = start react whenever $supplier.Supply {
            put Q :qq '"$_"';
        };

        sleep 0.001 while $p.status != Planned;
        while @stack {
            note "CURR FILES => ", @stack if $debug;
            my @stack-t = (@stack.race.map(
                                  sub ($_) {
                                      note "\t|GOT FILE => ", $_ if $debug;
                                      if nqp::lstat(nqp::unbox_s($_), nqp::const::STAT_ISDIR) == 1 {
                                          return .&getSubFiles;
                                      } else {
                                          my $fp  = &basename($_);
                                          my $ext = $fp.substr(($fp.rindex(".") // -1) + 1);

                                          note "\t=>GOT EXT = ", $ext if $debug;
                                          if %ext{$ignore-case ?? $ext.lc !! $ext} || (%whole{$ignore-case ?? $fp.lc !! $fp} ) {
                                              note "\t\t|SEND FILE ", $_ if $debug;
                                              $supplier.emit($_);
                                          }
                                      }
                                      return ();
                                  }
                              ).flat);
            @stack = @stack-t;
        };
    },
    :last
);

&getopt($os);

sub basename($filepath) {
    return $filepath.substr(($filepath.rindex('/') // -1) + 1);
}

sub getSubFiles($path) {
    my @ret := [];
    my $dh := nqp::opendir($path);

    while (my $f = nqp::nextfiledir($dh)) {
        @ret.push("$path/$f") if $f ne ".." && $f ne ".";
    }

    nqp::closedir($dh);

    return @ret;
}