unit role Pluggable;

use JSON::Fast;
use File::Find;

my sub match-try-add-module($module-name, $base, $namespace, $name-mat
+cher, @result) {
  if (   ($module-name.chars > "{$base}::{$namespace}".chars)
    && ($module-name.starts-with("{$base}::{$namespace}")) ) {

    if ((!defined $name-matcher) || ($module-name ~~ $name-matcher)) {
      try {
        CATCH {
          default {
            .say if ($*DEBUG-PLUGINS//False);
            say .WHAT.perl, do given .backtrace[0] { .file, .line, .su
+bname }
          }
        }
        require ::($module-name);
        @result.push(::($module-name));
      }
    }
  }
}

my sub find-modules($base, $namespace, $name-matcher) {
  my @result = ();

  for $*REPO.repo-chain -> $r {
    given $r.WHAT {
      when CompUnit::Repository::FileSystem {
        my @files = find(dir => $r.prefix, name => /\.pm6?$/);
        @files = map(-> $s { $s.substr($r.prefix.chars + 1) }, @files)
+;
        @files = map(-> $s { $s.substr(0, $s.rindex('.')) }, @files);
        @files = map(-> $s { $s.subst(/\//, '::', :g) }, @files);
        for @files -> $f {
          match-try-add-module($f, $base, $namespace, $name-matcher, @
+result);
        }
      }
      when CompUnit::Repository::Installation {
        # XXX perhaps $r.installed() could be leveraged here, but it
        # seems broken at the moment
        my $dist_dir = $r.prefix.child('dist');
        if ($dist_dir.?e) {
          for $dist_dir.IO.dir.grep(*.IO.f) -> $idx_file {
            my $data = from-json($idx_file.IO.slurp);
            for $data{'provides'}.keys -> $f {
              match-try-add-module($f, $base, $namespace, $name-matche
+r, @result);
            }
          }
        }
      }
      # XXX do we need to support more repository types?
    }
  }
  return @result.unique.Array;
}

method plugins(:$base = Nil, :$plugins-namespace = 'Plugins', :$name-m
+atcher = Nil) {
  my $class = "{$base.defined ?? $base !! ::?CLASS.^name}";
  return find-modules($class, $plugins-namespace, $name-matcher);
}

sub plugins($base, :$plugins-namespace = 'Plugins', :$name-matcher = N
+il) is export {
  return find-modules($base, $plugins-namespace, $name-matcher);
}
[download]

unit role Pluggable;

use JSON::Fast;
use File::Find;

# Public Interface

# search and load plugins
multi method plugins( :$base = Nil, :$plugins-namespace = 'Plugins', :
+$name-matcher = Nil ) {
  load-matching-modules( plugin-base($base), $plugins-namespace, $name
+-matcher );
}

# load a list of plugins
multi method plugins( @list-of-plugins ) {
  load-modules( @list-of-plugins );
}

multi sub plugins( $base = Nil, :$plugins-namespace = 'Plugins', :$nam
+e-matcher = Nil ) is export {
  load-matching-modules( $base, $plugins-namespace, $name-matcher );
}

multi sub plugins( $list-of-plugins ) is export {
  load-modules( $list-of-plugins );
}

method available-plugins(:$base = Nil, :$plugins-namespace = 'Plugins'
+, :$name-matcher = Nil ) {
  available-plugins( plugin-base($base), :$plugins-namespace, :$name-m
+atcher );
}

sub available-plugins( $base, :$plugins-namespace = 'Plugins', :$name-
+matcher = Nil ) is export {
  list-modules( $base, $plugins-namespace, $name-matcher );
}

# Private stuff
my sub plugin-base( $base ) { $base.defined ?? $base !! ::?CLASS.^name
+ }

my sub load-matching-modules( $base, $namespace, $name-matcher ) {
  load-modules( list-modules( $base, $namespace, $name-matcher ) )
}

my sub load-modules( $modules )
{
  $modules
    .map({ require-module( $_ ) })
    # Filter out modules that failed to load.
    # Note: We have a list of type objects here.
    # These are themselves "false" and their .defined property is "fal
+se" too
    # So don' replace the grep with something "simpler" like .grep({$_
+}) or .grep({.defined})
    .grep({ !.isa(Nil) })
    # Potentially, there same module is installed and locally in "lib"
+ at the same time
    .unique
    .Array;
}

my sub list-modules( $base, $namespace, $name-matcher ) {
  ( |matching-installed-modules( $base, $namespace, $name-matcher ),
    |matching-filesystem-modules( $base, $namespace, $name-matcher )
  ).unique.Array;
}

my sub matching-filesystem-modules( $base, $namespace, $name-matcher )
+ {
  matching-modules( all-filesystem-modules(), $base, $namespace, $name
+-matcher );
}

my sub matching-installed-modules( $base, $namespace, $name-matcher ) 
+{
  matching-modules( all-installed-modules(), $base, $namespace, $name-
+matcher );
}

my sub matching-modules( $modules, $base, $namespace, $name-matcher ) 
+{
  $modules.grep(-> $module-name {
    is-matching-module( $module-name, $base, $namespace, $name-matcher
+ );
  });
}

my sub is-matching-module( $module-name, $base, $namespace, $name-matc
+her ) {
  ( $module-name.chars > "{$base}::{$namespace}".chars ) &&
  ( $module-name.starts-with("{$base}::{$namespace}") ) &&
  ( (!defined $name-matcher) || ( $module-name ~~ $name-matcher ) );
}

my sub modules-in-directory( $directory ) {
  find(dir => $directory, name => /\.pm6?$/ )
    .map({ cleanup-module-name( $_, $directory ) });
}

my sub cleanup-module-name ( $module-name, $path-prefix ) {
  $module-name
    .substr( $path-prefix.chars + 1 ) # cut off the path
    .substr( 0, *-4 )                 # cut off the extension
    .subst( /\//, '::', :g )          # for linux et al
    .subst( /\\/, '::', :g );         # for windows
}

my sub require-module( $module-name ) {
  try require ::( $module-name );
  return ::( $module-name )
    unless $!;

  say "Warning: Unable to load <$module-name>";
  say $! if ( $*DEBUG-PLUGINS//False );
  return;
}

# Black magic
my sub all-filesystem-modules() {
  $*REPO.repo-chain
    .grep({ .isa( CompUnit::Repository::FileSystem ) })
    .map({ |modules-in-directory( .prefix ) });
}

my sub all-installed-modules() {
  # XXX perhaps $r.installed() could be leveraged here, but it
  # seems broken at the moment
  $*REPO.repo-chain
    .map({ say $_; $_ })
    .grep({ .isa( CompUnit::Repository::Installation ) })
    .map({ |modules-in-dist( .prefix ) });
}

my sub modules-in-dist( $directory ) {
  # Can't replace this with <map> as this mysteriously dies
  # under Windows ( https://github.com/rakudo/rakudo/issues/3120 )
  gather {
    try {
      for $directory.child('dist').IO.dir.grep(*.IO.f) -> $idx-file {
        take modules-in-idx-file( $idx-file );
      }
    }
  }.flat
}

sub modules-in-idx-file( $idx-file ) {
  try {
    my $data = from-json( $idx-file.IO.slurp );
    return $data{'provides'}.keys;
  }
}
[download]