Skip to content

Commit 79b39b0

Browse files
committed
Make Sourceable more awesome
TL;DR: You can just give it the code you have as is. Magic. The best interface is no interface. Previous version was a simple cover for the CoreHackers::Sourcery module, which is a collection of helper functions to get .file and .line of code blocks. It was OK, except that it required users to transform their code to a particular format in order to get the right output. This is no longer needed. With this rewrite, the original code as well as the dependency on CoreHackers::Sourcery are completely removed. Instead, the code implements whateverable-style crazy heuristics/brute force that tends to Just Work™ in pretty much all cases. To prove this, I used queries (found in the IRC log) to the previous version of the bot (SourceBaby), and was unable to find any case in which the current implementation did not work. Of course, creative users will eventually stumble upon something, so we'll likely need to improve it later. Also, now it's possible to use it for any rakudo commit. Of course.
1 parent ba87c4b commit 79b39b0

File tree

3 files changed

+190
-20
lines changed

3 files changed

+190
-20
lines changed

META6.json

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -47,8 +47,7 @@
4747
"Sake",
4848
"Stats",
4949
"Terminal::ANSIColor",
50-
"Text::Diff::Sift4",
51-
"CoreHackers::Sourcery"
50+
"Text::Diff::Sift4"
5251
],
5352
"resources" : [ ],
5453
"source-url" : "https://github.com/perl6/whateverable.git"

xbin/Sourceable.p6

Lines changed: 82 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,26 +1,100 @@
11
#!/usr/bin/env perl6
2+
# Copyright © 2019
3+
# Aleks-Daniel Jakimenko-Aleksejev <alex.jakimenko@gmail.com>
4+
# Copyright © 2019
5+
# Alexander Kiryuhin <alexander.kiryuhin@gmail.com>
6+
#
7+
# This program is free software: you can redistribute it and/or modify
8+
# it under the terms of the GNU Affero General Public License as published by
9+
# the Free Software Foundation, either version 3 of the License, or
10+
# (at your option) any later version.
11+
#
12+
# This program is distributed in the hope that it will be useful,
13+
# but WITHOUT ANY WARRANTY; without even the implied warranty of
14+
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15+
# GNU Affero General Public License for more details.
16+
#
17+
# You should have received a copy of the GNU Affero General Public License
18+
# along with this program. If not, see <http://www.gnu.org/licenses/>.
219

320
use Whateverable;
421
use Whateverable::Bits;
22+
use Whateverable::Builds;
523
use Whateverable::Output;
24+
use Whateverable::Running;
625

726
unit class Sourceable does Whateverable;
827

28+
my $BLOB-URL = https://github.com/rakudo/rakudo/blob;
29+
930
method help($msg) {
10-
"Like this: sourceable6: Int, 'base'";
31+
Like this: {$msg.server.current-nick}: 42.base(16)
1132
}
1233

13-
multi method irc-to-me($msg) {
14-
indir $*TMPDIR, sub {
15-
my $result = get-output($*EXECUTABLE.absolute, '-MCoreHackers::Sourcery', '-e', "put sourcery($msg.text())[1];");
34+
multi method irc-to-me($msg where { m:r/^ [$<maybe-rev>=\S+ \s+]? $<maybe-code>=[.+] $/ }) {
35+
my $full-commit = to-full-commit $<maybe-rev> // ;
36+
my $code = ~$<maybe-code>;
37+
if not $full-commit {
38+
$full-commit = to-full-commit HEAD;
39+
$code = ~$/;
40+
}
41+
my $short-commit = get-short-commit $full-commit;
42+
grumble No build for revision “$short-commit” unless build-exists $full-commit;
43+
44+
# Leave the build unpacked
45+
my $build-unpacked =
46+
run-smth $full-commit, {True}, :!wipe, :lock;
47+
LEAVE { run-smth $full-commit, {; }, :wipe, :!lock with $build-unpacked }
48+
49+
my @wild-guesses = gather {
50+
take $code; # code object (as-is)
51+
take & ~ $code; # sub
52+
# method
53+
for $code ~~ m:ex/^ (.+) ‘.’ (.+) $/ -> $/ {
54+
take {$0}.^can(‘$1’)[0]
55+
}
56+
# sub with args
57+
for $code ~~ m:ex/^ (.+) [ \s+ (.*) | ‘(’ (.*) ‘)’ ] $/ -> $/ {
58+
take &%s.cando(\(%s))[0].sprintf: $0, $1 // $2
59+
}
60+
# method with args
61+
for $code ~~ m:ex/^ (.+) ‘.’ (<[\w-]>+) [ [‘: ’ (.*)] | [‘(’ (.*) ‘)’]? ] $/ -> $/ {
62+
take (%s).^can(‘%s’).map(*.cando(\((%s), |\(%s)))).first(*.so)[0].sprintf: $0, $1, $0, $2 // $3 //
63+
}
64+
# infix operators
65+
for $code ~~ m:ex/^ (.+) \s+ (\S+) \s+ (.+) $/ -> $/ {
66+
take &[%s].cando(\(%s, %s))[0].sprintf: $1, $0, $2
67+
}
68+
# yeah, just some useful heuristics and brute force
69+
# ideally, it should work with QAST
70+
}
71+
72+
for @wild-guesses -> $tweaked-code {
73+
my $wrapped-code = with { ~ $tweaked-code ~ }() { print “\0\0” ~ .line ~ “\0\0” ~ .file ~ “\0\0” };
74+
my $file = write-code $wrapped-code;
75+
LEAVE .unlink with $file;
76+
77+
my $result = run-snippet $full-commit, $file, :!wipe, :!lock;
1678
if $result<exit-code> == 0 {
17-
return "Sauce is at $result<output>";
18-
} else {
19-
return "No idea, boss";
79+
my ($, $line, $file, $) = $result<output>.split: \0\0, 4; # hackety hack
80+
if $line and $file and $file.starts-with: SETTING:: {
81+
$file .= subst: /^SETTING::/, ;
82+
return $BLOB-URL/$short-commit/$file#L$line;
83+
}
2084
}
2185
}
86+
# Test the snippet itself
87+
my $file = write-code $code;
88+
my $result = run-snippet $full-commit, $file, :!wipe, :!lock;
89+
my $cry = No idea, boss. Can you give me a Code object?;
90+
if $result<exit-code> ≠ 0 {
91+
return ($cry Output: {$result<output>}
92+
but ProperStr($result<output>)) but PrettyLink({$cry Output: $_})
93+
}
94+
return $cry
2295
}
2396

2497
my %*BOT-ENV;
2598

26-
Sourceable.new.selfrun: 'sourceable6', [ / sourceable6? <before ':'> /, fuzzy-nick('sourceable6', 2) ];
99+
Sourceable.new.selfrun: 'sourceable6', [ / s <before ':'> /,
100+
fuzzy-nick('sourceable6', 2) ];

xt/sourceable.t

Lines changed: 107 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -8,19 +8,116 @@ use Testable;
88

99
my $t = Testable.new: bot => 'Sourceable';
1010

11-
$t.common-tests: help => "Like this: {$t.bot-nick}: Int, 'base'";
11+
$t.common-tests: help => Like this: {$t.bot-nick}: 42.base(16);
1212

13-
$t.test('call on type',
14-
"{$t.bot-nick}: Int, 'base'",
15-
/'https://github.com/rakudo/rakudo/blob/' .+? 'src/core/Int.pm6'/);
13+
$t.shortcut-tests: (s:, ),
14+
<s s,>;
1615

17-
$t.test('call on object',
18-
"{$t.bot-nick}: 42.3, 'base'",
19-
/'https://github.com/rakudo/rakudo/blob/' .+? 'src/core/Rational.pm6'/);
16+
my $link = https://github.com/rakudo/rakudo/blob/;
2017

21-
$t.test('call with args',
22-
"{$t.bot-nick}: 42, 'base', \\(16)",
23-
/'https://github.com/rakudo/rakudo/blob/' .+? 'src/core/Int.pm6'/);
18+
$t.test(code object,
19+
{$t.bot-nick}: &copy,
20+
/$link .+? ‘src/core.c/io_operators.pm6’/);
21+
22+
$t.test(sub without ampersand,
23+
{$t.bot-nick}: copy,
24+
/$link .+? ‘src/core.c/io_operators.pm6’/);
25+
26+
$t.test(sub with args (parens),
27+
{$t.bot-nick}: ~ sprintf('<%#B>', 12),
28+
/$link .+? ‘src/core.c/Cool.pm6’/);
29+
30+
$t.test(sub with args no parens,
31+
{$t.bot-nick}: ~ sprintf '<%#B>', 12,
32+
/$link .+? ‘src/core.c/Cool.pm6’/);
33+
34+
$t.test(method on type,
35+
{$t.bot-nick}: Int.base,
36+
/$link .+? ‘src/core.c/Int.pm6’/);
37+
38+
$t.test(method on object,
39+
{$t.bot-nick}: 42.3.base,
40+
/$link .+? ‘src/core.c/Rational.pm6’/);
41+
42+
$t.test(method with args (parens),
43+
{$t.bot-nick}: 42.base(16),
44+
/$link .+? ‘src/core.c/Int.pm6’/);
45+
46+
$t.test(method with args: colon,
47+
{$t.bot-nick}: 42.base: 16,
48+
/$link .+? ‘src/core.c/Int.pm6’/);
49+
50+
$t.test(operator,
51+
{$t.bot-nick}: ~ &infix:['+<'],
52+
/$link .+? ‘src/core.c/Numeric.pm6’/);
53+
54+
$t.test(operator with args,
55+
{$t.bot-nick}: ~ &infix:['+<'](1, 2),
56+
/$link .+? ‘src/core.c/Int.pm6’/);
57+
58+
$t.test(infix operator,
59+
{$t.bot-nick}: 1 < 2,
60+
/$link .+? ‘src/core.c/Int.pm6’/);
61+
62+
63+
# Other revisions (not HEAD)
64+
65+
$t.test(running on a provided revision,
66+
{$t.bot-nick}: 6c2f24455c NaN.FatRat.Bool(),
67+
/^ <me($t)>‘, https://github.com/rakudo/rakudo/blob/6c2f244/src/core/Rational.pm6#L77’ $/);
68+
69+
70+
# Errors
71+
72+
$t.test(not a code-like thing,
73+
{$t.bot-nick}: ∞,
74+
/^ <me($t)>‘, No idea, boss. Can you give me a Code object?’ $/);
75+
76+
$t.test(syntax error,
77+
{$t.bot-nick}: 2 +,
78+
/^ <me($t)>‘, No idea, boss. Can you give me a Code object? Output: ’ .* ‘===’ .* ‘SORRY!’ .* $/);
79+
80+
81+
# Proto vs actual method
82+
83+
my $proto-line;
84+
$t.test(proto without parens,
85+
{$t.bot-nick}: 42.hash,
86+
/$link .+? ‘src/core.c/Any.pm6#L’(\d+) {$proto-line=+~$0} $/);
87+
88+
my $concrete-line;
89+
$t.test(concrete with parens,
90+
{$t.bot-nick}: 42.hash(),
91+
/$link .+? ‘src/core.c/Any.pm6#L’(\d+) {$concrete-line=+~$0} $/);
92+
93+
cmp-ok $proto-line, &[<], $concrete-line, ;
94+
95+
96+
# More complex cases
97+
98+
$t.test(range with infix dot,
99+
{$t.bot-nick}: ^10 .reverse.skip(10).iterator(),
100+
/$link .+? ‘src/core.c/Seq.pm6’/);
101+
102+
$t.test(range with infix dot (no parens for method call),
103+
{$t.bot-nick}: ^10 .reverse.skip(10).iterator,
104+
/$link .+? ‘src/core.c/Seq.pm6’/);
105+
106+
$t.test(atomic op,
107+
{$t.bot-nick}: ~ &postfix:<⚛++>(my atomicint $x),
108+
/$link .+? ‘src/core.c/atomicops.pm6’/);
109+
110+
$t.test(skipping of undefined candidates,
111+
{$t.bot-nick}: ~ /^/.ACCEPTS(any("opensuse", "linux")),
112+
/$link .+? ‘src/core.c/Code.pm6’/);
113+
114+
$t.test(large piece of code,
115+
{$t.bot-nick}: ~ Seq.new(class :: does Iterator { has $!n = 10; method pull-one {say "pulling!"; $!n-- and 42 or IterationEnd }; method skip-one { $!n-- }; method count-only { 10 } }.new).tail(),
116+
/$link .+? ‘src/core.c/Any-iterable-methods.pm’/);
117+
118+
$t.test(stderr warnings are ignored,
119+
{$t.bot-nick}: ~ (my %b = :1a).ACCEPTS(my %a = :1a),
120+
/$link .+? ‘src/core.c/Map.pm6’/);
24121

25122
$t.last-test;
26123
done-testing;

0 commit comments

Comments
 (0)