This repository has been archived by the owner on Jun 6, 2018. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Options.pm6
100 lines (91 loc) · 3.83 KB
/
Options.pm6
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
class CommandLine::Usage::Options {
method apply($base, @filter) {
my @candidates;
my @explanations;
my Bool $filter-by-constraint = @filter.elems > 0; # Are we doing subcommand usage?
if $filter-by-constraint {
for $base.func.candidates -> $candidate {
my Bool $got-it = False;
loop ( my $i=0; $i < @filter.elems; $i++ ) {
my $param = $candidate.signature.params[$i];
next unless $param;
my @param-constraints = $param.constraint_list();
if @param-constraints[0] {
my Str $first-constraint = @param-constraints[0]; # Probably doesn't scale on more complicated stuff
$got-it = $first-constraint eq @filter[$i];
}
last if $got-it == False;
}
if $got-it {
@candidates.push: $candidate;
@explanations.push: $candidate.WHY;
}
}
} else {
for $base.conf.candidates -> $candidate {
my $param = $candidate.signature.params[0];
if $param.constraint_list().elems == 0 {
@candidates.push: $candidate;
}
}
}
my $out-options = self.parse-options(:candidates(@candidates));
if $out-options.chars > 0 {
$base.replace:
OPTIONS-TEXT => $filter-by-constraint ?? " [OPTIONS]" !! '',
OPTIONS-LIST => "Options:\n$out-options"
;
} else {
$base.replace:
OPTIONS-TEXT => ''
;
}
}
method parse-options (:@candidates) {
my $out = '';
for @candidates -> $candidate {
for $candidate.signature.params -> $param {
next if $param.constraint_list();
my $short-param = '';
my $long-param = '';
my $default-value = '';
my $param-type = '';
my token type { \w+ <?before \s> }
my token name { <-[\s\$():]>+ }
my token short-name { <?after ':'> <name> <?before '('> };
my token long-name { <?after ':$'> <name> };
my token separator { '(:' };
$param-type = $0 if $param.perl ~~ /^ (<type>) /;
$short-param = "-$0" if $param.perl ~~ / (<short-name>) /;
$long-param = "--$0" if $param.perl ~~ / (<long-name>) /;
$default-value = $0 if $param.perl ~~ / '=' \s* '"'? (<-["]>+) '"'? /;
given $param-type {
when 'Int' {
$param-type = 'integer';
}
when 'Str' {
$param-type = 'string';
}
default {
$param-type = 'string' if $default-value ~~ / \w /;
}
}
$long-param ~= " $param-type".lc if $param-type.chars > 0;
next if $short-param eq $long-param;
$short-param ~= $short-param.chars > 0 && $long-param.chars > 0 ?? ', ' !! ' ';
my $usage = $param.WHY ?? $param.WHY.Str !! '';
if $default-value {
$default-value ~~ s/ '\$HOME' /$*HOME/;
$usage ~= ' ' if $usage.chars > 0 and $default-value.chars > 0;
$usage ~= "(default \"$default-value\")";
}
$out ~= sprintf("%6s%-21s%s\n",
$short-param.chars > 0 ?? $short-param !! '',
$long-param.chars > 0 ?? $long-param !! '',
$usage
);
}
}
$out;
}
}