Merge pull request #10869 from ppentchev/pp-287-raku

Add Peter Pentchev's Raku solutions to 287

7 files changed, 340 insertions, 61 deletions

diff --git a/challenge-287/ppentchev/REUSE.toml b/challenge-287/ppentchev/REUSE.toml
new file mode 100644
index 0000000000..c94dec6f95
--- /dev/null
+++ b/challenge-287/ppentchev/REUSE.toml
@@ -0,0 +1,13 @@
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+version = 1
+SPDX-PackageName = "pwc-287-ppentchev"
+SPDX-PackageSupplier = "Peter Pentchev <roam@ringlet.net>"
+SPDX-PackageDownloadLocation = "https://devel.ringlet.net/{{ website_section }}/{{ name }}/"
+
+[[annotations]]
+path = "blog.txt"
+precedence = "aggregate"
+SPDX-FileCopyrightText = "Peter Pentchev <roam@ringlet.net>"
+SPDX-License-Identifier = "BSD-2-Clause"
diff --git a/challenge-287/ppentchev/docs/index.md b/challenge-287/ppentchev/docs/index.md
index ff6dd94112..ec92fdf7d2 100644
--- a/challenge-287/ppentchev/docs/index.md
+++ b/challenge-287/ppentchev/docs/index.md
@@ -261,6 +261,16 @@ directly as three scalar variables instead of any kind of structured data.
 Of course it would be possible to stash them into a hash or a simple object, but
 this way was a bit simpler.
 
+#### Raku
+
+The Raku solution is quite similar to the Perl one, but it encapsulates the number of
+actions taken and the current state of the password string into a `Strength` class.
+It also encapsulates the state of the parser used to find too-long runs of the same
+character into a `RunState` class.
+
+The `fix_runs()`, `fix_length()`, and `fix_missing()` functions are translated into
+the `fix-runs()`, `fix-length()`, and `fix-missing()` methods of the `Strength` class.
+
 ### Task 2: Valid Number
 
 #### Perl
@@ -273,6 +283,16 @@ The Perl solution has three major elements:
   depending on whether the argument represents a valid number
 - `parse_stdin` - read a line from the standard input, return it as a string to be examined
 
+#### Raku
+
+In the Raku solution we chose the other way: write a simple grammar (`ValidNumber`) that
+will recognize a number as defined in the problem.
+The grammar is so simple that it does not even need to define any actions; returning
+a non-empty, defined result is enough to determine whether the input was recognized.
+
+Well, okay, since Raku grammars are actually regular expressions in disguise, one might
+argue that we did not go so far the other way then :)
+
 ## Contact
 
 These solutions were written by [Peter Pentchev][roam].
diff --git a/challenge-287/ppentchev/raku/scripts/ch-1.raku b/challenge-287/ppentchev/raku/scripts/ch-1.raku
new file mode 100755
index 0000000000..38336f8a8a
--- /dev/null
+++ b/challenge-287/ppentchev/raku/scripts/ch-1.raku
@@ -0,0 +1,145 @@
+#!/usr/bin/raku
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+my Int:D constant $DESIRED_LENGTH = 6;
+my Bool:D constant $PWC_QUIET = (%*ENV{'PWC_QUIET'} // '') eq '1';
+my Bool:D constant $PWC_USE_LOCALE = (%*ENV{'PWC_USE_LOCALE'} // '') eq '1';
+
+my Str:D @TEST_STRINGS = 'a', 'aB2', 'PassW0rd', 'PaaaSW0rd', 'aaaaa';
+
+sub diag(Str:D $msg)
+{
+	$msg.note unless $PWC_QUIET;
+}
+
+class Strength
+{
+	has Int:D $.actions is required is readonly;
+	has Int:D $.length is required is readonly;
+	has Int:D $.missing is required is readonly;
+	has Int:D @.runs is required is readonly;
+
+	method fix-runs() returns Strength:D
+	{
+		my $taken = (@.runs.map: (* / 3).Int).sum;
+		my $missing = $.missing >= $taken ?? $.missing - $taken !! 0;
+		Strength.new(:actions($.actions + $taken), :$.length, :$missing, :runs())
+	}
+
+	method fix-length() returns Strength:D
+	{
+		my $taken = $.length < $DESIRED_LENGTH ?? $DESIRED_LENGTH - $.length !! 0;
+		my $missing = $.missing >= $taken ?? $.missing - $taken !! 0;
+		Strength.new(:actions($.actions + $taken), :length($.length + $taken), :$missing, :@.runs)
+	}
+
+	method fix-missing() returns Strength:D
+	{
+		my $taken = $.missing > 0 ?? $.missing !! 0;
+		Strength.new(:actions($.actions + $taken), :$.length, :missing(0), :@.runs)
+	}
+}
+
+sub diag-strength(Str:D $tag, Strength:D $strength)
+{
+	diag "strength at $tag: "
+		~ "actions " ~ $strength.actions
+		~ ", length " ~ $strength.length
+		~ ", missing " ~ $strength.missing
+		~ ", runs " ~ $strength.runs.raku
+		unless $PWC_QUIET;
+}
+
+class RunState
+{
+	has Int:D @.runs is required is readonly;
+	has Str:D $.last is required is readonly;
+	has Int:D $.count is required is readonly;
+
+	method update(Str:D $char) returns RunState
+	{
+		if $char eq $.last {
+			RunState.new(:@.runs, :$.last, :count($.count + 1))
+		} elsif $.count >= 3 {
+			RunState.new(:runs(|@.runs, $.count), :last($char), :count(1))
+		} else {
+			RunState.new(:@.runs, :last($char), :count(1))
+		}
+	}
+
+	method update-finish() returns RunState
+	{
+		if $.count >= 3 {
+			RunState.new(:runs(|@.runs, $.count), :last(' '), :count(0))
+		} else {
+			self
+		}
+	}
+}
+
+enum CharClass
+(
+	ChLower => 'lower',
+	ChUpper => 'upper',
+	ChDigit => 'digit',
+);
+
+sub classify(Str:D $char) returns CharClass
+{
+	if $PWC_USE_LOCALE {
+        	given $char {
+        		when / <lower> / { ChLower }
+        		when / <upper> / { ChUpper }
+        		when / <digit> / { ChDigit }
+        		default { Nil }
+        	}
+	} else {
+        	given $char {
+        		when / <[a .. z]> / { ChLower }
+        		when / <[A .. Z]> / { ChUpper }
+        		when / <[0 .. 9]> / { ChDigit }
+        		default { Nil }
+        	}
+	}
+}
+
+sub examine-password(Str:D $password) returns Strength:D
+{
+	my $length = $password.chars;
+	my $run_init_state = RunState.new(:runs(), :last(' '), :count(0));
+	my @chars = $password.split('', :skip-empty);
+	my @runs = (
+		reduce { $^state.update($^value) }, $run_init_state, |@chars
+	).update-finish.runs;
+	my $missing = 3 - @chars.map(&classify).grep(*.defined).Set.elems;
+	Strength.new(:actions(0), :$length, :$missing, :@runs)
+}
+
+sub strong-password(Str:D $password) returns Int:D
+{
+	my $st_init = examine-password $password;
+	diag-strength 'init', $st_init;
+
+	my $st_runs = $st_init.fix-runs;
+	diag-strength 'runs', $st_runs;
+
+	my $st_length = $st_runs.fix-length;
+	diag-strength 'length', $st_length;
+
+	my $st_missing = $st_length.fix-missing;
+	diag-strength 'missing', $st_missing;
+
+	$st_missing.actions
+}
+
+{
+	if (%*ENV{'PWC_FROM_STDIN'} // '') eq '1' {
+		my $line = $*IN.get;
+		say strong-password $line;
+	} else {
+        	for @TEST_STRINGS {
+        		say strong-password $^password;
+        	}
+	}
+}
diff --git a/challenge-287/ppentchev/raku/scripts/ch-2.raku b/challenge-287/ppentchev/raku/scripts/ch-2.raku
new file mode 100755
index 0000000000..b97869d3f3
--- /dev/null
+++ b/challenge-287/ppentchev/raku/scripts/ch-2.raku
@@ -0,0 +1,37 @@
+#!/usr/bin/raku
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+my Str:D @TEST_NUMBERS = '1', 'a', '.', '1.2e4.2', '-1.', '+1E-8', '.44';
+
+grammar ValidNumber
+{
+	token TOP { <mantissa> <exponent>? };
+
+	token mantissa { <large-number> | <small-number> };
+	token exponent { <[Ee]> <int-sign>? <int-digit>+ }
+
+	token large-number { <int-sign>? <int-digit>+ <large-fractional-part>? };
+	token large-fractional-part { <[.]> <int-digit>* }
+	token small-number { <[.]> <int-digit>+ }
+
+	token int-sign { <[+-]> };
+	token int-digit { <[0 .. 9]> };
+}
+
+sub valid-number(Str:D $str) returns Str:D
+{
+	my $parsed = try ValidNumber.parse($str);
+	!$! && $parsed.defined ?? 'true' !! 'false'
+}
+
+{
+	if (%*ENV{'PWC_FROM_STDIN'} // '') eq '1' {
+		my $line = $*IN.get;
+		say valid-number $line;
+	} else {
+        	for @TEST_NUMBERS {
+        		say valid-number $^str;
+        	}
+	}
+}
diff --git a/challenge-287/ppentchev/tests/03-raku-ch-1.t b/challenge-287/ppentchev/tests/03-raku-ch-1.t
new file mode 100644
index 0000000000..f872ba899c
--- /dev/null
+++ b/challenge-287/ppentchev/tests/03-raku-ch-1.t
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+use v5.16;
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib 'tests/lib';
+
+use PWCTest::Ch287 qw(find_raku test_strong_password test_strong_password_count test_strong_password_default);
+
+use constant PROG => 'raku/scripts/ch-1.raku';
+
+my $raku;
+BEGIN {
+    $raku = find_raku;
+}
+
+if (!defined $raku) {
+    plan skip_all => 'no Raku interpreter found';
+    exit 0;
+}
+
+plan tests => 2;
+
+my $raku_prog = [$raku, '--', PROG];
+
+subtest strong_password_default => sub {
+	test_strong_password_default $raku_prog;
+};
+
+subtest strong_password => sub {
+    plan tests => test_strong_password_count;
+    for my $idx (1..test_strong_password_count) {
+        subtest "run $idx" => sub {
+            test_strong_password $raku_prog, $idx - 1;
+        };
+    }
+};
diff --git a/challenge-287/ppentchev/tests/04-raku-ch-2.t b/challenge-287/ppentchev/tests/04-raku-ch-2.t
new file mode 100644
index 0000000000..ba3d393def
--- /dev/null
+++ b/challenge-287/ppentchev/tests/04-raku-ch-2.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+use v5.16;
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib 'tests/lib';
+
+use PWCTest::Ch287 qw(
+	find_raku
+	test_valid_number
+	test_valid_number_count
+	test_valid_number_default
+);
+
+my $raku;
+BEGIN {
+	$raku = find_raku;
+}
+
+if (!defined $raku) {
+	plan skip_all => 'no Raku interpreter found';
+	exit 0;
+}
+
+plan tests => 2;
+
+use constant PROG => 'raku/scripts/ch-2.raku';
+
+my $raku_prog = [$raku, '--', PROG];
+
+subtest valid_number_default => sub {
+	test_valid_number_default $raku_prog;
+};
+
+subtest valid_number => sub {
+    plan tests => test_valid_number_count;
+    for my $idx (1..test_valid_number_count) {
+        subtest "run $idx" => sub {
+            test_valid_number $raku_prog, $idx - 1;
+        };
+    }
+};
diff --git a/challenge-287/ppentchev/tests/lib/PWCTest/Ch287.pm b/challenge-287/ppentchev/tests/lib/PWCTest/Ch287.pm
index 943543f9b8..e0c6d2d791 100644
--- a/challenge-287/ppentchev/tests/lib/PWCTest/Ch287.pm
+++ b/challenge-287/ppentchev/tests/lib/PWCTest/Ch287.pm
@@ -19,6 +19,7 @@ use Test::Command qw();
 use Test::More;
 
 our @EXPORT_OK = qw(
+	find_raku
 	test_strong_password
 	test_strong_password_count
 	test_strong_password_default
@@ -47,32 +48,12 @@ my @TEST_NUMBERS = (
 	['.44', 'true'],
 );
 
-sub test_strong_password_default($) {
-	my ($cmd) = @_;
+sub test_run_program($ $ $) {
+	my ($cmd, $input, $expected) = @_;
 	my $prog = "\`@{$cmd}\`";
 
 	plan tests => 2;
 
-	my $auto_cmd = Test::Command->new(cmd => ['env', 'PWC_FROM_STDIN=', @{$cmd}]);
-	$auto_cmd->exit_is_num(0, "$prog exited with code 0");
-	$auto_cmd->stdout_is_eq(
-		"5\n3\n0\n1\n2\n",
-		"$prog produced the correct output in autotest mode",
-	);
-}
-
-sub test_strong_password_count() {
-	scalar @TEST_PASSWORDS
-}
-
-sub test_strong_password($ $) {
-	my ($cmd, $idx) = @_;
-	my $prog = "\`@{$cmd}\`";
-
-	plan tests => 2;
-
-	my ($password, $expected) = @{$TEST_PASSWORDS[$idx]};
-
 	# OK, so Test::Command cannot handle this one; let's do it ourselves
 	socketpair(my $parent_in, my $child_in, AF_UNIX, SOCK_STREAM, 0) or
 		die "Could not create the stdin socket pair: $!\n";
@@ -95,7 +76,7 @@ sub test_strong_password($ $) {
 	close $child_in or die "Parent: could not close child_in: $!\n";
 	close $child_out or die "Parent: could not close child_out: $!\n";
 
-	say $parent_in $password or die "Parent: could not write to the child: $!\n";
+	say $parent_in $input or die "Parent: could not write to the child: $!\n";
 	close $parent_in or die "Parent: could not close parent_in: $!\n";
 
 	my $line = <$parent_out>;
@@ -110,7 +91,7 @@ sub test_strong_password($ $) {
 	is $?, 0, "$prog exited with code 0";
 }
 
-sub test_valid_number_default($) {
+sub test_strong_password_default($) {
 	my ($cmd) = @_;
 	my $prog = "\`@{$cmd}\`";
 
@@ -119,58 +100,52 @@ sub test_valid_number_default($) {
 	my $auto_cmd = Test::Command->new(cmd => ['env', 'PWC_FROM_STDIN=', @{$cmd}]);
 	$auto_cmd->exit_is_num(0, "$prog exited with code 0");
 	$auto_cmd->stdout_is_eq(
-		"true\nfalse\nfalse\nfalse\ntrue\ntrue\ntrue\n",
+		"5\n3\n0\n1\n2\n",
 		"$prog produced the correct output in autotest mode",
 	);
 }
 
-sub test_valid_number_count() {
-	scalar @TEST_NUMBERS
+sub test_strong_password_count() {
+	scalar @TEST_PASSWORDS
 }
 
-sub test_valid_number($ $) {
+sub test_strong_password($ $) {
 	my ($cmd, $idx) = @_;
+	my ($password, $expected) = @{$TEST_PASSWORDS[$idx]};
+
+	test_run_program $cmd, $password, $expected;
+}
+
+sub test_valid_number_default($) {
+	my ($cmd) = @_;
 	my $prog = "\`@{$cmd}\`";
 
 	plan tests => 2;
 
-	my ($str, $expected) = @{$TEST_NUMBERS[$idx]};
-
-	# OK, so Test::Command cannot handle this one; let's do it ourselves
-	socketpair(my $parent_in, my $child_in, AF_UNIX, SOCK_STREAM, 0) or
-		die "Could not create the stdin socket pair: $!\n";
-	socketpair(my $child_out, my $parent_out, AF_UNIX, SOCK_STREAM, 0) or
-		die "Could not create the stdout socket pair: $!\n";
-	my $pid = fork();
-	if (!defined $pid) {
-		die "Could not fork for $prog: $!\n";
-	} elsif ($pid == 0) {
-		close $parent_in or die "Child: could not close parent_in: $!\n";
-		close $parent_out or die "Child: could not close parent_out: $!\n";
-		dup2(fileno $child_in, 0) or die "Child: could not dup2 child_in onto stdin: $!\n";
-		dup2(fileno $child_out, 1) or die "Child: could not dup2 child_out onto stdout: $!\n";
+	my $auto_cmd = Test::Command->new(cmd => ['env', 'PWC_FROM_STDIN=', @{$cmd}]);
+	$auto_cmd->exit_is_num(0, "$prog exited with code 0");
+	$auto_cmd->stdout_is_eq(
+		"true\nfalse\nfalse\nfalse\ntrue\ntrue\ntrue\n",
+		"$prog produced the correct output in autotest mode",
+	);
+}
 
-		$ENV{PWC_FROM_STDIN} = '1';
-		exec { $cmd->[0] } @{$cmd};
-		die "Child: could not execute $prog: $!\n";
-	}
+sub test_valid_number_count() {
+	scalar @TEST_NUMBERS
+}
 
-	close $child_in or die "Parent: could not close child_in: $!\n";
-	close $child_out or die "Parent: could not close child_out: $!\n";
+sub test_valid_number($ $) {
+	my ($cmd, $idx) = @_;
+	my ($str, $expected) = @{$TEST_NUMBERS[$idx]};
 
-	say $parent_in $str or die "Parent: could not write to the child: $!\n";
-	close $parent_in or die "Parent: could not close parent_in: $!\n";
+	test_run_program $cmd, $str, $expected;
+}
 
-	my $line = <$parent_out>;
-	close $parent_out or die "Parent: could not close parent_out: $!\n";
-	is $line, "$expected\n", "$prog produced the correct output";
-	my $awaited_pid = waitpid $pid, 0;
-	if (!defined $awaited_pid) {
-		die "Parent: could not wait for child pid $pid: $!\n";
-	} elsif ($awaited_pid != $pid) {
-		die "Parent: waited for pid $pid, yet got status $? for pid $awaited_pid\n";
-	}
-	is $?, 0, "$prog exited with code 0";
+sub find_raku()
+{
+	my $prog = $ENV{RAKU} || 'raku';
+	my $res = system { $prog } ($prog, '-e', 'use strict');
+	(defined $res && $res == 0) ? $prog : undef
 }
 
 1;