use v6;
use lib './';
use CLIInteractive;
use CommandSnark;
my CLI::Interactive $cli .= new;
$cli.register-command-instance(Alfred::Command::Snark.new);
sub MAIN(|argument-string) {
if argument-string.Str eq '' {
}
else {
$cli.dispatch('snark test');
}
say 'hello';
}
class X::CLI::Interactive::UnknownCommand is Exception {
has $.command;
method message() {
"Command '$.command' not found. Did you register it?"
}
}
class CLI::Interactive {
has %!commands;
method dispatch(Str $command-string) is export {
my ($main-command, $rest) = $command-string.split(" ", 2);
if ($rest) {
say "Dispatching $command-string";
my ($sub-command, $arguments) = $rest.split(" ", 2);
my $full-command = "{$main-command}::{$sub-command}";
die X::CLI::Interactive::UnknownCommand.new(command => $full-command)
unless %!commands{$full-command}:exists;
my $command = %!commands{$full-command};
my &method = $command<method>;
method($command<class-instance>); # No args (aside from class invocant)
}
else {
die X::CLI::Interactive::UnknownCommand.new(command => $main-command)
unless %!commands{$main-command}:exists;
my $command = %!commands{$main-command};
my &method = $command<method>;
say &method.^name;
say $command<class-instance>.^name;
&method($command<class-instance>); # No args (aside from class invocant)
}
}
method register-command-instance($command-instance) is export {
# Take the last parse of the class name and lowercase it for the command name
# TODO: Allow command name to be overriden via either a trait or a property
my $command-name = $command-instance.^name.split('::').reverse.first.lc;
for $command-instance.^methods.grep(* ~~ Method) -> Method $method {
# TODO: Better way to detect if method has sub-command trait?
next unless $method.name eq 'MAIN' or $method.^name eq 'Method+{Routine::Wrapped}';
next if $method.name eq 'cli'; # Skip the cli accessor method created for us by Perl
my $sub-command-name = $method.name eq 'MAIN' ?? Nil !! $method.name;
my %command-spec = 'help' => ~$method.WHY,
'signature' => $method.signature,
'class-instance' => $command-instance,
'method' => $method; # TODO: Is this callable?
if $sub-command-name {
%!commands{"{$command-name}::{$sub-command-name}"} = %command-spec;
}
else {
%!commands{"{$command-name}"} = %command-spec;
}
}
$command-instance.cli = self;
}
}
use CLIInteractiveCommand;
class Alfred::Command::Snark is CLI::Interactive::Command {
#| Snarky
method test() is cli-command {
say "Hello";
}
}
use CLIInteractive;
multi sub trait_mod:<is>(Method $m, :$cli-command!) is export {
$m.wrap: sub (|) {
nextsame;
}
}
class CLI::Interactive::Command {
has CLI::Interactive $.cli is rw;
}
