Skip to content
Permalink
Browse files

Refactor MAIN_HELPER / add support for &ARGS-TO-CAPTURE

This introduces support for an &ARGS-TO-CAPTURE to exist in the code
where the MAIN also exists.  It takes an array of ARGS, and is supposed
to return a Capture.  If there is no such sub, then it will use the
default one living inside MAIN_HELPER.

This should allow GetOpt::Long type of modules to simplify their code
to just supply an &ARGS-TO-CAPTURE sub without having to worry about
the actual dispatch specifics.
  • Loading branch information...
lizmat committed Oct 10, 2018
1 parent 9daac68 commit 33c241532b14f342803cfca64b6fcd8aa4f3535f
Showing with 36 additions and 32 deletions.
  1. +36 −32 src/core/Main.pm6
@@ -10,20 +10,21 @@ my sub MAIN_HELPER($IN-as-ARGSFILES, $retval = 0) {
my $main := callframe(1).my<&MAIN>;
return $retval unless $main;

my %SUB-MAIN-OPTS := %*SUB-MAIN-OPTS // {};
my $no-named-after := nqp::isfalse(%SUB-MAIN-OPTS<named-anywhere>);

sub thevalue(\a) {
((my \type := ::(a)) andthen Metamodel::EnumHOW.ACCEPTS(type.HOW))
?? type
!! val(a)
}
my %SUB-MAIN-OPTS := %*SUB-MAIN-OPTS // {};

# Convert raw command line args into positional and named args for MAIN
my sub process-cmd-args(@args is copy --> Capture:D) {
my sub ARGS-TO-CAPTURE(@args is copy --> Capture:D) {
my $no-named-after = nqp::isfalse(%SUB-MAIN-OPTS<named-anywhere>);

my $positional := nqp::create(IterationBuffer);
my %named;

sub thevalue(\a) {
((my \type := ::(a)) andthen Metamodel::EnumHOW.ACCEPTS(type.HOW))
?? type
!! val(a)
}

while @args {
my str $passed-value = @args.shift;

@@ -66,29 +67,10 @@ my sub MAIN_HELPER($IN-as-ARGSFILES, $retval = 0) {
Capture.new( list => $positional.List, hash => %named )
}

# Select candidates for which to create USAGE string
sub usage-candidates($capture) {
my @candidates = $main.candidates;
my @positionals = $capture.list;

my @candos;
while @positionals && !@candos {

# Find candidates on which all these positionals match
@candos = @candidates.grep: -> $sub {
my @params = $sub.signature.params;
(^@positionals).first( -> int $i {
!(@params[$i].constraints.ACCEPTS(@positionals[$i]))
} ).defined.not;
}
@positionals.pop;
}
(@candos || $main.candidates)
.grep: { nqp::not_i(nqp::can($_,'is-hidden-from-USAGE')) }
}

# Generate $?USAGE string (default usage info for MAIN)
my sub gen-usage($capture) {
my $no-named-after = nqp::isfalse(%SUB-MAIN-OPTS<named-anywhere>);

my @help-msgs;
my Pair @arg-help;

@@ -112,6 +94,27 @@ my sub MAIN_HELPER($IN-as-ARGSFILES, $retval = 0) {
?? "-e '...'"
!! strip_path_prefix($prog-name);

# Select candidates for which to create USAGE string
sub usage-candidates($capture) {
my @candidates = $main.candidates;
my @positionals = $capture.list;

my @candos;
while @positionals && !@candos {

# Find candidates on which all these positionals match
@candos = @candidates.grep: -> $sub {
my @params = $sub.signature.params;
(^@positionals).first( -> int $i {
!(@params[$i].constraints.ACCEPTS(@positionals[$i]))
} ).defined.not;
}
@positionals.pop;
}
(@candos || $main.candidates)
.grep: { nqp::not_i(nqp::can($_,'is-hidden-from-USAGE')) }
}

for usage-candidates($capture) -> $sub {
my @required-named;
my @optional-named;
@@ -220,7 +223,8 @@ my sub MAIN_HELPER($IN-as-ARGSFILES, $retval = 0) {
}

# Process command line arguments
my $capture := process-cmd-args(@*ARGS);
my $capture :=
(callframe(1).my<&ARGS-TO-CAPTURE> // &ARGS-TO-CAPTURE)(@*ARGS);

# Generate default $?USAGE message
my $usage;
@@ -240,7 +244,7 @@ my sub MAIN_HELPER($IN-as-ARGSFILES, $retval = 0) {
grep: { !has-unexpected-named-arguments(.signature, $capture.hash) };

# If there are still some candidates left, try to dispatch to MAIN
if +@matching_candidates {
if @matching_candidates {
if $IN-as-ARGSFILES {
my $*ARGFILES := IO::ArgFiles.new: (my $in := $*IN),
:nl-in($in.nl-in), :chomp($in.chomp), :encoding($in.encoding),

0 comments on commit 33c2415

Please sign in to comment.
You can’t perform that action at this time.