Hello fellow ones!
Welcome to the first (?) Sunday Perl Challenge Trip! The challenge will last one week and then points will be calculated. I dont hope someone is mad enough to accept the challange, but I think is more fun this way, instead of posting my code alone. But who knows..
Assignement
We need to implement nested autocompletion while reading user input: the command A lead to options 1 2 3 and command B to 4 5 etc..
Simple? No: a dread :) Let specify it better. Given the following data:
# dummy items to play with
my @animals = (qw( cow camel dog cat ));
my @foods = (qw( fish pasture meat ));
my @places = (qw( wood sea desert ));
# commands
my $commands = {
select => {
completion_list => \@animals,
commands => {
give => {
completion_list => \@foods,
},
take_to => {
completion_list => \@places,
},
},
},
kill => {
completion_list => \@animals,
}
};
the first choices are only select and kill and if you choose select (entering it or using selTAB to autocomplete it) then autocomplete should permit only one item from @animals Once you entered (directly or autocompleting it) an animal then only the two commands give and take_to should be available. And so on.
I used hardcoded keywords commands and completion_list to drive my solution: feel free to use them or not or to change them.
An example session:
Press TAB for autocompletion or available options
autocompletion nested>("kill", "select")
+ # 'TAB' on empty input shows available commands
autocompletion nested>select c("camel", "cat", "cow")
+ # 'cTAB' shows animals but not 'dog'
autocompletion nested>select ca("camel", "cat")
+ # 'caTAB' shows two animals starting with 'ca'
autocompletion nested>select camel ("give", "take_to")
+ # I press 'mTAB' thae autocomplete in 'camel'
+ # 'TAB' again for next level commands: give and take_to
autocompletion nested>select camel take_to ("desert", "sea", "wood")
+ # 'tTAB' and 'TAB' again
autocompletion nested>select camel take_to desert
+ # 'desTAB' leads to 'desert'
+ # ENTER 1
autocompletion nested>
+ # ENTER 2 exits the user input cycle
CHOOSEN: select camel take_to desert
+ # finally we print the resulting path
Points
- +50 points to get the job done. Runnable code.
- +Reputation of the node when the challenge close
- -5 for reading Hint1 (declare it in the answer):
- -10 for reading Hint2 (declare it in the answer):
- -20 for reading my solution (declare it in the answer: it includes Hint1 and Hint2) and use it as starting point :)
Extra points
- +40 points for not using Term::ReadLine family modules :)
- +20 points for a correct use of BACKSPACE to have editable lines: you change your mind and you go back through the line
- +10 points if you are able to avoid the double ENTER I need to end the line building when we reached the end of the datastructure
- +100 points if you publish it as CPAN module in this week
- my ethernal gratidute if I understand your code :)
My solution
My code is ugly enough, but it works. It is full of comments to help you understing what's going on. Some unused code is commented to show possible improvemnts. It has some debug options: 0 (default), 1, 2 that ruins a bit the output but are useful to see the flow.
Avoid to comment my code before the challange ends. Here we are:
Have fun!
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
|
Re: [challenge] Nested autocompletion
by tybalt89 (Monsignor) on Feb 13, 2023 at 16:40 UTC
|
This might not be exactly what you want but it was fun anyways :)
Done without looking at hints or other code.
Runs in xterm on ArchLinux, don't know about other systems...
#!/usr/bin/perl
use strict; # https://perlmonks.org/?node_id=11150326
use warnings;
use List::Util qw( uniq );
use Term::ReadKey;
# dummy items to play with
my @animals = (qw( cow camel dog cat ));
my @foods = (qw( fish pasture meat ));
my @places = (qw( wood sea desert ));
# commands
my $commands = {
select => {
completion_list => \@animals,
commands => {
give => { completion_list => \@foods, },
take_to => { completion_list => \@places, },
},
},
kill => { completion_list => \@animals, }
};
my $completed = autocomplete( $commands, 'test autocomplete> ' );
print $completed ? "\nThe user entered: $completed\n" : "\nEscape\n";
exit;
######################################################################
sub autocomplete
{
my ($commands, $prompt) = @_;
my $lines = join "\n", lines($commands), '';
$prompt //= '> ';
my $input = '';
my $clearline = "\e[G\e[K";
my $skip;
$| = 1;
ReadMode 'raw';
eval
{
while()
{
$skip or print $clearline, $prompt, $input;
$skip = 0;
my $char = ReadKey;
$char =~ tr/\e\cc// and $input = '', last;
$char =~ tr/\n\r// and $lines =~ /^$input$/m ? last : next;
$char eq "\b" and chop($input), next;
if( $char eq "\t" )
{
my ($new, $letters) = extend($input, $lines);
if( not defined $new )
{
# shorten to longest legal string
$input = "$input\n$lines" =~ /^(.*).*\n(?:.*\n)*\1/ ? $1 : '
+';
next;
}
$input = $new;
my $info = (extend($input, $lines))[1] || '***Complete!';
my $len = 2 + length $info;
print $clearline, $prompt, $input, " \e[92m$info\e[m\e[${len}
+D";
$skip = 1;
next;
}
$input .= $char;
}
};
ReadMode 'restore';
print "\n";
return $input;
}
sub extend
{
my ($in, $lines) = @_;
my $match = join '', $lines =~ /^\Q$in\E.*\n/gm;
my $extend = $match =~ /^(.*).*\n(?:\1.*\n)*\z/? $1 : undef;
my $letters = join ' ', sort + uniq $lines =~ /^\Q$in\E(\S+)/gm;
return $extend, $letters;
}
sub lines
{
my $cmd = shift or return '';
map s/ +$//r, map { my $key = $_; # fun triple map nesting
map { my $prev = $_;
map "$key $_ $prev", @{ $cmd->{$key}{completion_list} };
} lines( $cmd->{$key}{commands} )
} keys %$cmd;
}
| [reply]
[d/l] |
Re: [challenge] Nested autocompletion
by tybalt89 (Monsignor) on Feb 16, 2023 at 16:32 UTC
|
While testing my other post Re: [challenge] Nested autocompletion I noticed I was always typing one letter and then a tab.
So why not auto-tab?
Here it is: maximum effect for least effort :)
The only tricky part was getting backspace to work, because it usually has to back up more than one letter.
#!/usr/bin/perl
use strict; # https://perlmonks.org/?node_id=11150326
use warnings; # constant autocomplete
use List::Util qw( uniq );
use Term::ReadKey;
$| = 1;
my @animals = (qw( cow camel dog cat ));
my @foods = (qw( fish pasture meat ));
my @places = (qw( wood sea desert ));
my $commands = {
select => {
completion_list => \@animals,
commands => {
give => { completion_list => \@foods, },
take_to => { completion_list => \@places, },
},
},
kill => { completion_list => \@animals, }
};
my $completed = autocomplete( $commands, 'auto> ' );
print $completed ? "\nThe user entered: $completed\n" : "\nEscape\n";
exit;
######################################################################
sub autocomplete
{
my $commands = shift;
my $prompt = shift // '> ';
my $lines = ref $commands ? join "\n", lines($commands), '' : $comma
+nds;
my $input = '';
my ($clearline, $color, $reset) = ("\e[G\e[K", "\e[32m", "\e[m");
ReadMode 'raw';
eval
{
while()
{
$input = "$input\n$lines" =~ /^(.*).*\n(?:.*\n)*\1/ ? $1 : '';
$input = $lines =~ s/^(?!\Q$input\E).*\n//gmr =~
/^(.*).*\n(?:\1.*\n)*\z/ ? $1 : '';
my $words = join ' ', sort + uniq $lines =~ /^\Q$input\E ?(\S+)/
+gm;
$lines =~ /^$input\n/m and $words = '*** Completed!';
my $backup = "\e[" . ( 2 + length $words ) . "D";
print "$clearline$prompt$input $color$words$reset$backup";
my $char = ReadKey;
$char =~ tr/\e\cc// and $input = '', last;
$char =~ tr/\n\r// and $lines =~ /^$input$/m ? last : next;
$char =~ tr/ -~// and $input .= $char;
if( $char =~ tr/\b\x7f// ) # backspace
{
my $match = 1 + ( () = $lines =~ /^\Q$input\E/gm );
$input = "$input\n$lines" =~
/^(.*).*\n(?:(?:(?!\1).*\n)*\1.*\n){$match}/ ? $1 : '';
}
}
1;
};
my $error = $@;
ReadMode 'restore';
print "$error\n";
return $input;
}
sub lines
{
my $cmd = shift or return '';
map s/ +$//r, map { my $key = $_; # fun triple map nesting
map { my $prev = $_;
map "$key $_ $prev", @{ $cmd->{$key}{completion_list} };
} lines( $cmd->{$key}{commands} )
} keys %$cmd;
}
This should become another entry in my (never to be written) Master Work: The Only Data Structure Needed Is A Multi-Line String.
| [reply]
[d/l] |
Re: [challenge] Nested autocompletion -- results and some question
by Discipulus (Canon) on Feb 20, 2023 at 10:42 UTC
|
Hello everybody!
the challange ended and, surprise!, we had two participants and three solutions plus my own one.
Results
Notes about points
Anonymous Monk's solution has a minor defect: it allows also kill snake where snake is not among @animals and also select WHALE take_to desert so is more a relaxed version of what I intended, but I have accept it as valid. The backspace behaviour is implemented only on terms not on the whole line. The logic of the program is very neat and easy to understand: my ethernal gratitude :) 16 XP atm
tybalt89 first attempt is already very nice to see. It runs fine only on Linux (more on this below). The all-in-one-line interface is very appealing, as the use of colors. The backspace beahviour is missing (also more on this below): if you erase cow in select cow and then type doTAB you get back to select cow It has 19 XP atm.
tybalt89 second solution is really, really cute to see (on Linux again: maybe life is too short to support unfriendly OSs? ;): it is what I'd like to see in every interactive commandline utility. It also implements the backspace usage correctly so +10, and despite only 15 XP, because of this it wins the challange.
Notes about implementations
Dear Anonymous Monk maybe you do not want to signup in the monastery because of ... , but it is a pity for us not to be able to answer directly: infact I contacted the author of the Term::Completion module, addressing them to your comments and because of this they published their first github repository for the module. They seems very open to suggestions: feel free to contribute there :) Infact one of my best achivements here was to contribute to convince tybalt89 to abandon Anonymous Monk's cloak and finally signin. Programs proposed by tybalt89 are very smart as always and I will need to study them with a bit of patience before understanding them completely, but you always deserve my gratitude, no fear :)
Both programs by tybalt89 show a rare beahviour on Win32: in effect the backspace works well on terms and on the whole line too, but the output is pested of errors emitted by Term::ReadKey complaining with Use of uninitialized value in subroutine entry at C:/perl5.26.64bit/perl/site/lib/Term/ReadKey.pm line 476.
Line 476 of the file on my pc is Win32PeekChar($File, $_[0]); but is not the same line on cpan, even for the very same 2.38 version. Only calling the program as perl autocompletion-nested-tybalt89.pl 2> nul I get the program running correctly.
I looked at the source of Term::ReadKey but I flew away puzzled very soon.
The nasty error comes out with ReadMode 'cbreak' 'raw' 'ultra-raw' so 3,4,5 and here you have the minimal code to reproduce it:
use strict;
use warnings;
use Term::ReadKey;
$| = 1;
ReadMode 'raw';
while(){
my $char = ReadKey;
# infinite, unbreakable looop without this check
if ( $char eq 'x' ){
# broken console on Linux without this!
ReadMode 'restore';
last;
}
print "[$char]";
}
What is happening on Win32?
Conclusion
It was very fun for me to see your solutions, as always an answer leads to many other questions.
The prize is a bottle of organic red wine and it can be received here in Roma without any time limit :)
Thanks!
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
| [reply]
[d/l]
[select] |
|
|
$char eq "\b" and chop($input), next;
with
$char =~ tr/\b\x7f// and chop($input), next;
Note that "tybalt89 second" already has that fix.
About Win32: I do not have a Win32 system to test on, however I do have a fix for that:
Do not use Win32
Thanks for the challenge and I hope you enjoyed the regexes in "tybalt89 second", particularly the "backspace" one.
| [reply]
[d/l]
[select] |
|
|
Hello again tybalt89 and all,
I need to stop trusting code by others, even if by experienced programmers like you :)
It comes out ReadKey.pm is generated from ReadKey.pm.PL and generates different output on different systems: so on linux it checks for undefined values while on win32 it does not. To me this is bug so I created an issue.
The docs of Term::ReadKey say you need to pass a MODE to the ReadKey function.
So instead of my $char = ReadKey; you need instead my $char = ReadKey(-1); next unless defined $char;
For future convenience here is the patched version of your second program, fixed for win32:
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
| [reply]
[d/l]
[select] |
|
|
|
|
|
|
| |
|
Hello tybalt89,
yes you are right: I've tested both your programs in the "linux console" not in "xterm" and because of this I noticed the wrong backspace behaviour. So your first program deserved 10 points more jumping to 129 and to the gold medal..
As the second program had the fix already applied I got nice backspace effect under "linux console" and I gave it +10 points.
I'm somehow happy for my error because I like the second program a lot.
I enjoyed your regexes but I have to admit they are very hard to understand for me, and the whole program too.
For the Win32 definitive fix ( Do not use Win32 ;) I can understand and accept your position, but supporting such a big market share is a plus for perl: I will hammer here and there to get rid of the warning emitted by Term::ReadKey
Message me to get the prize when you come in the Ethernal City :)
Thanks!
L*
There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
| [reply]
[d/l]
[select] |
|
|
|
|
|
Re: [challenge] Nested autocompletion
by LanX (Saint) on Feb 13, 2023 at 11:38 UTC
|
Some meditation (I didn't re(veal|ad) your code) ...
As far as I understand the complication is in the grammar and not in the auto-completion and you are shying away from implementing/maintaining a state-machine.
From your description I understand this (pseudo syntax)
- [ select | kill ] @animals [ give @foods | take_to @places ]
But it seems to me that kill shouldn't allow further commands
- [ kill @animals | select @animals [ give @foods | take_to @places ] ]
It's also not clear if give and take_to can be followed by further commands
- [ kill @animals | select @animals [ give @foods | take_to @places ] ]? # quantifier ? one-or-more commands
Or if you can have multiple items:
- [ kill @animals | select @animals [ give (@foods)? | take_to @places ] ] # ? one-or-more food items
What about senseless food-selection by animal?
select camel give fish #???
hence we need
- ... select @animals [ give ( @{$foods{$select}} )? ... # updated
The next question is validation , what happens if a someone manually types select horse ... which isn't in the animal-list, shouldn't that be rejected?
My naïve approach would be to implement/translate that grammar to a nested regex and input that doesn't match is rejected.
Typing TAB after a command displays the completion list.²
But I have a hunch there are already better ways to implement such grammars on CPAN.
²) from what I remember this can be done with Term::ReadLine by adding call backs for evaluation and expansion. | [reply]
[d/l]
[select] |
Re: [challenge] Nested autocompletion
by Anonymous Monk on Feb 13, 2023 at 12:55 UTC
|
Hurray, challenge on Monday! And I'm mad alright thank-you, so I qualify. Haven't seen OP's code nor spoilers, so maybe I didn't quite get it. Basic logic would be:
| [reply]
[d/l]
[select] |
|
|
