Raku 基础

Unable to parse expression in argument list; couldn't find final ')'

$ docker pull rakudo-star

$ docker run -it rakudo-star raku:2017.04

$ docker run -v $PWD:/raku -w /raku -it rakudo-star raku

alias p6d='docker run -v $PWD:/raku -w /raku -it rakudo-star raku'

$ p6d -e 'say "hi"'
hi

$ wget https://rakudo.org/dl/star/rakudo-star-2017.04.tar.gz
tar.gz
$ tar xzf rakudo-star-2017.04.tar.gz
$ cd rakudo-star-2017.04/
$ perl Configure.pl --prefix=$HOME/opt/rakudo-star --gen-moar
$ make install

PATH=$PATH:$HOME/opt/rakudo-star/bin/:$HOME/opt/rakudo-star/share/raku/site/bin

$ raku --version
This is Rakudo version 2017.04.2 built on MoarVM version 2017.04
implementing Raku.c.

$ raku -e "say <hi>"
hi

# file sudoku.p6
use v6;
my $sudoku = '000000075000080094000500600010000200000900057006003040001000023080000006063240000';
$sudoku = $sudoku.trans('0' => ' ');
for 0..8 -> $line-number {
    say substr $sudoku, $line-number * 9, 9;
}

$ raku sudoku.p6
       75
     8 94
    5 6
   1  2
    9  57
   6 3 4
   1   23
   8    6
   6324

+---+---+---+
|   | 1 |   |
|   |   |79 |
|  9|   |4  |
+---+---+---+
|   | 4 | 5 |
|   |   | 2 |
| 3 | 29|18 |
+---+---+---+
|  4| 87|2  |
|  7| 2 |95 |
| 5 | 3 | 8 |
+---+---+---+

sub chunks(Str $s, Int $chars) {
    gather loop (my $idx = 0; $idx < $s.chars; $idx += $chars) {
        take substr($s, $idx, $chars); }
    }

for chunks($sudoku, 9) -> $line {
    say chunks($line, 3).join('|');
}

$ raku sudoku.p6
   |   | 75
   | 8 | 94
   |5  |6
 1 |   |2
   |9  | 57
  6|  3| 4
  1|   | 23
  8|   | 6
63 |24 |

gather {
    take 1;
    take 2;
}

for chunks($sudoku, 9) -> $line {
    say chunks($line, 3).join('|');
}

say '|', chunks($line, 3).join('|'), '|';

|   |   | 75|
|   | 8 | 94|
|   |5  |6  |
| 1 |   |2  |
|   |9  | 57|
| 6 | 3 | 4 |
| 1 |   | 23|
| 8 |   | 6 |
| 63|24 |   |

my $separator = '+---+---+---+';
my $index = 0;
for chunks($sudoku, 9) -> $line {
    if $index++ %% 3 {
        say $separator;
    }
    say '|', chunks($line, 3).join('|'), '|';
}
say $separator;

+---+---+---+
|   |   | 75|
|   | 8 | 94|
|   |5  |6  |
+---+---+---+
| 1 |   |2  |
|   |9  | 57|
|  6|  3| 4 |
+---+---+---+
|  1|   | 23|
| 8 |   |  6|
| 63|24 |   |
+---+---+---+

my $x = 0;
say $x++;
say $x;

# file sudoku.p6
use v6;

my $sudoku = '000000075000080094000500600010000200000900057006003040001000023080000006063240000';
$sudoku = $sudoku.trans('0' => ' ');
my $separator = '+---+---+---+';
my $index = 0;
for $sudoku.comb(9) -> $line {
    if $index++ %% 3 {
        say $separator;
    }
    say '|', $line.comb(3).join('|'), '|';
}
say $separator;

say $separator if $index++ %% 3;

my $separator = '+---+---+---+'; for $sudoku.comb(9) -> $line {
say $separator if $++ %% 3;
    say '|', $line.comb(3).join('|'), '|';
}
say $separator;

# file sudoku.p6
use v6;

my $sudoku = '000000075000080094000500600010000200000900057006003040 001000023080000006063240000';
$sudoku = $sudoku.trans: '0' => ' ';

constant separator = '+---+---+---+';
for $sudoku.comb(9) -> $line {
    say separator if $++ %% 3;
    say '|', $line.comb(3).join('|'), '|';
}
say separator;

# file sudoku.p6
use v6;

constant separator = '+---+---+---+';

sub MAIN($sudoku) {
    my $substituted = $sudoku.trans: '0' => ' ';

    for $substituted.comb(9) -> $line {
        say separator if $++ %% 3;
        say '|', $line.comb(3).join('|'), '|';
    }
    say separator;
}

$ raku-m sudoku-format-08.p6 0000000750000800940005006000100002000009 00057006003040001000023080000006063240000

+---+---+---+
|   |   | 75|
|   | 8 | 94|
|   |5  |6  |
+---+---+---+
| 1 |   |2  |
|   |9  | 57|
|  6|  3| 4 |
+---+---+---+
|  1|   | 23|
| 8 |   |  6|
| 63|24 |   |
+---+---+---+

$ raku-m sudoku.p6
Usage:
  sudoku.p6 <sudoku>

# file sudoku.p6
use v6;

constant separator = '+---+---+---+';

for lines() -> $sudoku {
    my $substituted = $sudoku.trans: '0' => ' ';

    for $substituted.comb(9) -> $line {
        say separator if $++ %% 3;
        say '|', $line.comb(3).join('|'), '|';
    }
    say separator;
}

<?xml version="1.0" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/ Graphics/SVG/1.1/DTD/svg11.dtd">
<svg width="304" height="304" version="1.1" xmlns="http://www.w3.org/2000/svg">
<line x1="0" x2="300" y1="33.3333" y2="33.3333" style="stroke:grey" />
<line x1="0" x2="300" y1="66.6667" y2="66.6667" style="stroke:grey" />
<line x1="0" x2="303" y1="100" y2="100" style="stroke:black; stroke-width:2"/>
<line x1="0" x2="300" y1="133.333" y2="133.333" style="stroke:grey" />
    <!-- more horizontal lines here -->
<line y1="0" y2="300" x1="33.3333" x2="33.3333" style="stroke:grey" />
<!-- more vertical lines here -->
<text x="43.7333" y="124.5"> 1 </text>
<text x="43.7333" y="257.833"> 8 </text>
<!-- more cells go here -->
<rect width="304" height="304" style="fill:none;stroke-width: 1;stroke:black;stroke-width:6"/>
</svg>

$ raku -e "say DateTime.new(1480915200)"
2016-12-05T05:20:00Z

sub MAIN (Int $timestamp) {
    say DateTime.new($timestamp)
}

$ autotime 1450915200
Invalid DateTime string '1450915200'; use an ISO 8601 timestamp (yyyy-mm-ddThh:mm:ssZ or yyyy-mm-ddThh:mm:ss+01:00) instead
  in sub MAIN at autotime line 2
  in block <unit> at autotime line 2

sub MAIN(Int $timestamp) {
    say $timestamp.^name;
    say DateTime.new($timestamp)
}

IntStr

sub MAIN(Int $timestamp) {
    say DateTime.new(+$timestamp)
}

$ ./autotime-01.p6 1450915200
2015-12-24T00:00:00Z

sub MAIN(Int $timestamp) {
    my $dt = DateTime.new(+$timestamp);
    if $dt.hour == 0 && $dt.minute == 0 && $dt.second == 0 {
        say $dt.Date;
    }
    else {
        say $dt;
    }
}

$ ./autotime 1450915200
2015-12-24

if all($dt.hour, $dt.minute, $dt.second) == 0 {
    say $dt.Date;
}

if none($dt.hour, $dt.minute, $dt.second) {
    say $dt.Date;
}

if $dt.Date.DateTime == $dt {
    say $dt.Date;
}
else {
    say $dt;
}

2015-12-24T00:00:01Z

2015-12-24 00:00:01

sub MAIN(Int $timestamp) {
    my $dt = DateTime.new(+$timestamp, formatter => sub ($o) {
            sprintf '%04d-%02d-%02d %02d:%02d:%02d',
                    $o.year, $o.month,  $o.day,
                    $o.hour, $o.minute, $o.second,
    });
    if $dt.Date.DateTime == $dt {
        say $dt.Date;
    }
    else {
        say $dt.Str;
    }
}

./autotime 1450915201
2015-12-24 00:00:01

sub MAIN(Int $timestamp) {
    sub formatter($o) {
        sprintf '%04d-%02d-%02d %02d:%02d:%02d',
                $o.year, $o.month,  $o.day,
                $o.hour, $o.minute, $o.second,
    }
    my $dt = DateTime.new(+$timestamp, formatter => &formatter);
    if $dt.Date.DateTime == $dt {
        say $dt.Date;
    }
    else {
        say $dt.Str;
    }
}

sub MAIN($input) {
    if $input ~~ / ^ \d+ $ / {
        # convert from timestamp to date/datetime
    }
    else {
        # convert from date to timestamp

    }
}

multi sub MAIN(Int $timestamp) {
    sub formatter($o) {
        sprintf '%04d-%02d-%02d %02d:%02d:%02d',
                $o.year, $o.month,  $o.day,
                $o.hour, $o.minute, $o.second,
    }
    my $dt = DateTime.new(+$timestamp, :&formatter);
    if $dt.Date.DateTime == $dt {
        say $dt.Date;
    }
    else {
        say $dt.Str;
    }
}

multi sub MAIN(Str $date) {
    say Date.new($date).DateTime.posix
}

$ ./autotime 2015-12-24
1450915200
$ ./autotime 1450915200
Ambiguous call to 'MAIN'; these signatures all match:
:(Int $timestamp)
:(Str $date)
  in block <unit> at ./autotime line 17

multi sub MAIN(Str $date where /^ \d+ \- \d+ \- \d+ $ /) {
    say Date.new($date).DateTime.posix
}

Invalid Date string 'foobar'; use yyyy-mm-dd instead

multi sub MAIN(Str $date where { try Date.new($_) }) {
    say Date.new($date).DateTime.posix
}

$ ./autotime 2015-12-24;
1450915200
$ ./autotime 1450915200
2015-12-24

multi sub MAIN(Str $date where { try Date.new($_) }, Str $time?) {
    my $d = Date.new($date);
    if $time {
        my ( $hour, $minute, $second ) = $time.split(':');
        say DateTime.new(date => $d, :$hour, :$minute, :$second).posix;
    }
    else {
        say $d.DateTime.posix;
    }
}

DateTime.new(date => $d, hour => $h, minute => $m, second => $s);

./autotime 2015-12-24 11:23:00
1450956180

$ ./autotime 1450956180
2015-12-24 11:23:00

for 1..3 {
    .say
}

1
2
3

sub formatter($_) {
    sprintf '%04d-%02d-%02d %02d:%02d:%02d',
            .year, .month,  .day,
            .hour, .minute, .second,
}

given DateTime.new(+$timestamp, :&formatter) {
    if .Date.DateTime == $_ {
        say .Date;
    }
    else {
        .say;
    }
}

given DateTime.new(+$timestamp, :&formatter) {
    when .Date.DateTime == $_ { say .Date }
    default { .say }
}

multi sub MAIN(Int \timestamp) {
    ...
    given DateTime.new(+timestamp, :&formatter) {
    ...
    }
}

multi sub MAIN(Int \timestamp) {
    sub formatter($_) {
        sprintf '%04d-%02d-%02d %02d:%02d:%02d',
                .year, .month,  .day,
                .hour, .minute, .second,
    }
    given DateTime.new(+timestamp, :&formatter) {
        when .Date.DateTime == $_ { say .Date }
        default { .say }
    }
}

multi sub MAIN(Str $date where { try Date.new($_) }, Str $time?) {
    my $d = Date.new($date);
    if $time {
        my ( $hour, $minute, $second ) = $time.split(':');
        say DateTime.new(date => $d, :$hour, :$minute, :$second).posix;
    }
    else {
        say $d.DateTime.posix;
    }
}

$ ./autotime
Usage:
  ./autotime <timestamp>
  ./autotime <date> [<time>]

#| Convert timestamp to ISO date
multi sub MAIN(Int \timestamp) {
    ...
}

#| Convert ISO date to timestamp
multi sub MAIN(Str $date where { try Date.new($_) }, Str $time?) {
    ...
}

$ ./autotime
Usage:
  ./autotime <timestamp> -- Convert timestamp to ISO date
  ./autotime <date> [<time>] -- Convert ISO date to timestamp

sub from-timestamp(Int \timestamp) {
    sub formatter($_) {
        sprintf '%04d-%02d-%02d %02d:%02d:%02d',
            .year, .month, .day,
            .hour, .minute, .second,
    }
    given DateTime.new(+timestamp, :&formatter) {
        when .Date.DateTime == $_ { return .Date }
        default { return $_ }
    }
}

sub from-date-string(Str $date, Str $time?) {
    my $d = Date.new($date);
    if $time {
        my ( $hour, $minute, $second ) = $time.split(':');
        return DateTime.new(date => $d, :$hour, :$minute, :$second);
    } else {
        return $d.DateTime;
    }
}

#| Convert timestamp to ISO date
multi sub MAIN(Int \timestamp) {
    say from-timestamp(+timestamp);
}

#| Convert ISO date to timestamp
multi sub MAIN(Str $date where { try Date.new($_) }, Str $time?) {
    say from-date-string($date, $time).posix;
}

#| Run internal tests
multi sub MAIN('test') {
    use Test;
    plan 4;
    is-deeply from-timestamp(1450915200), Date.new('2015-12-24'), 'Timestamp to Date';

    my $dt = from-timestamp(1450915201);
    is $dt, "2015-12-24 00:00:01", 'Timestamp to DateTime with string formatting';
    is from-date-string('2015-12-24').posix, 1450915200, 'from-date-string, one argument';
    is from-date-string('2015-12-24', '00:00:01').posix, 1450915201, 'from-date-string, two arguments';
}

./autotime test
1..4
ok 1 - Timestamp to Date
ok 2 - Timestamp to DateTime with string formatting
ok 3 - from-date-string, one argument
ok 4 - from-date-string, two arguments

$ prove -e "" "./autotime test"
./autotime-tested.p6 test .. ok

All tests successful.
Files=1, Tests=4, 0 wallclock secs ( 0.02 usr 0.01 sys + 0.23 cusr 0.02 csys = 0.28 CPU)
Result: PASS

multi sub MAIN('test') {

multi sub MAIN(Str $anon where {$anon eq 'test'}) {

#| Run internal tests
multi sub MAIN('test') {
    use Test; plan 2;

    subtest 'timestamp', {
        plan 2;
        is-deeply from-timestamp(1450915200), Date.new('2015-12-24'), 'Date';;

        my $dt = from-timestamp(1450915201);
        is $dt, "2015-12-24 00:00:01", 'DateTime with string formatting';
    };

    subtest 'from-date-string', {
        plan 2;
        is from-date-string('2015-12-24').posix, 1450915200, 'one argument';
        is from-date-string('2015-12-24', '00:00:01').posix, 1450915201, 'two arguments';
    };
}

1..2
    1..2
    ok 1 - Date
    ok 2 - DateTime with string formatting
ok 1 - timestamp
    1..2
    ok 1 - one argument
    ok 2 - two arguments
ok 2 - from-date-string

sub MAIN(*@cmd) {
    my $proc = Proc::Async.new(|@cmd);
    my $collector = Channel.new;
    for $proc.stdout, $proc.stderr -> $supply {
        $supply.tap: { $collector.send($_) }
    }
    my $result = $proc.start.result;
    $collector.close;
    my $output = $collector.list.join;
    my $exitcode = $result.exitcode;
    if $exitcode != 0 {
        say "Program @cmd[] exited with code $exitcode";
        print "Output:\n", $output if $output;
    }
    exit $exitcode;
}

sub MAIN(*@cmd) {

my $proc = Proc::Async.new(|@cmd);

my $collector = Channel.new;

for $proc.stdout, $proc.stderr -> $supply {
    $supply.tap: { $collector.send($_) }
}

$proc.stdout.tap: { $collector.send($_) }
$proc.stderr.tap: { $collector.send($_) }

my $result = $proc.start.result;

$collector.close;
my $output = $collector.list.join;

my $exitcode = $result.exitcode;
if $exitcode != 0 {
    say "Program @cmd[] exited with code $exitcode";
    print "Output:\n", $output if $output;
}
exit $exitcode;

say "Program @cmd[] exited with code $exitcode";

say "Program @cmd.join(' ') exited with code $exitcode";

sub MAIN(*@cmd, :$timeout) {
    my $proc = Proc::Async.new(|@cmd);
    my $collector = Channel.new;
    for $proc.stdout, $proc.stderr -> $supply {
        $supply.tap: { $collector.send($_) }
    }

    my $promise = $proc.start;
    my $waitfor = $promise;
    $waitfor = Promise.anyof(Promise.in($timeout), $promise)
        if $timeout;
    await $waitfor;
}

$waitfor = Promise.anyof(Promise.in($timeout), $promise)

if !$timeout || $promise.status ~~ Kept {
    my $exitcode = $promise.result.exitcode;
    my $output = $collector.list.join;

    if $exitcode != 0 {
        say "Program @cmd[] exited with code $exitcode";
        print "Output:\n", $output if $output;
    }
    exit $exitcode;
}
else {
    ...
}

else { $proc.kill;
    say "Program @cmd[] did not finish after $timeout seconds";
    sleep 1 if $promise.status ~~ Planned;
    $proc.kill(9);
    await $promise;
    exit 2;
}

my $dummy = await $promise

$ = await $promise

sub count-primes(Int $upto) {
    (1..$upto).grep(&is-prime).elems;
}

my $p = start count-primes 10_000;
say $p.status;
await $p;
say $p.result;

Planned
1229

sub count-primes(Int $upto) {
    (1..$upto).grep(&is-prime).elems;
}

my $p1 = start count-primes 10_000;
my $p2 = $p1.then({ say .result });
await $p2;

sub pi-approx($iterations) {
    my $inside = 0;
    for 1..$iterations {
        my $x = 1.rand;
        my $y = 1.rand;
        $inside++ if $x * $x + $y * $y <= 1;
    }
    return ($inside / $iterations) * 4;
}
my @approximations = (1..1000).map({ start pi-approx(80) });
await @approximations;

say @approximations.map({.result}).sum / @approximations;

my $*SCHEDULER = ThreadPoolScheduler.new(:max_threads(3));

use DBIish;
my $dbh = DBIish.connect('SQLite', :database('database-file.sqlite3'));

$dbh.do('INSERT INTO player (name) VALUES ?', 'John');

my $sth = $dbh.prepare('SELECT id FROM player WHERE name = ?');
my %ids;
for <John Jack> -> $name {
    $sth.execute($name);
    %ids{ $name } = $sth.row[0];
}
$sth.finish;

my $repo = ExecutionResultRepository.new(
    jobname => 'refresh cache',
    statefile => 'silent-cron.sqlite3',
);
$repo.insert($result);
my @last-results = $repo.tail(5);

class ExecutionResultRepository {
    has $.jobname is required;
    has $.statefile is required;
    # ... more code

has $!db; method !db() {
    return $!db if $!db;
    $!db = DBIish.connect('SQLite', :database($.statefile));
    self!create-schema();
    return $!db;
}

constant $table = 'job_execution';
method !create-schema() {
    $!db.do(qq:to/SCHEMA/);
        CREATE TABLE IF NOT EXISTS $table (
            id          INTEGER PRIMARY KEY,
            jobname     VARCHAR NOT NULL,
            exitcode    INTEGER NOT NULL,
            timed_out   INTEGER NOT NULL,
            output      VARCHAR NOT NULL,
            executed    TIMESTAMP NOT NULL DEFAULT (DATETIME('NOW'))
        );

    SCHEMA
    $!db.do(qq:to/INDEX/);
        CREATE INDEX IF NOT EXISTS {$table}_jobname_exitcode ON
        $table ( jobname, exitcode );
    INDEX
    $!db.do(qq:to/INDEX/);
        CREATE INDEX IF NOT EXISTS {$table}_jobname_executed ON
        $table ( jobname, executed );
    INDEX
}

print q:to/EOS/;
    Not indented
        Indented four spaces
    EOS

Not indented
    Indented four spaces

method insert(ExecutionResult $r) {
    self!db.do(qq:to/INSERT/, $.jobname, $r.exitcode, $r.timed-out, $r.output);
        INSERT INTO $table (jobname, exitcode, timed_out, output)
        VALUES(?, ?, ?, ?)
    INSERT
}

method tail(Int $count) {
    my $sth = self!db.prepare(qq:to/SELECT/);
        SELECT exitcode, timed_out, output
          FROM $table
          WHERE jobname = ?
          ORDER BY executed DESC
          LIMIT $count
    SELECT
    $sth.execute($.jobname);
    $sth.allrows(:array-of-hash).map: -> %h {
        ExecutionResult.new(
            exitcode  => %h<exitcode>,
            timed-out => ?%h<timed_out>,
            output    => %h<output>,
        );
    }
}

multi sub MAIN(*@cmd, :$timeout, :$jobname is copy,
               :$statefile='silent-cron.sqlite3', Int :$tries = 3) {
    $jobname //= @cmd.Str;
    my $result = run-with-timeout(@cmd, :$timeout);
    my $repo = ExecutionResultRepository.new(:$jobname, :$statefile);
    $repo.insert($result);

    my @runs = $repo.tail($tries);

    unless $result.is-success or @runs.grep({.is-success}) {
        say "The last @runs.elems() runs of @cmd[] all failed, the last execution ",
        $result.timed-out ?? "ran into a timeout"
                          !! "exited with code $result.exitcode()";

        print "Output:\n", $result.output if $result.output;
    }
    exit $result.exitcode // 2;
}

sub chunks(Str $s, Int $chars) {
#         ^^^^^^^^^^^^^^^^^^^^ signature
#   ^^^^^^ name
    gather for 0 .. $s.chars / $chars - 1 -> $idx {
        take substr($s, $idx * $chars, $chars);
    }
}

say &chunks.name; # Output: chunks

say chunks 'abcd', 2; # Output: (ab cd)
say chunks('abcd', 2); # Output: (ab cd)

say chunks(join('x', 'ab', 'c'), 2);

say chunks(join 'x', 'ab', 'c', 2);

say chunks join('x', 'ab', 'c'), 2;

sub random-choice() {
    Bool.pick;
}

# right way:
if random-choice() {
    say 'You were lucky.';
}

# wrong way:
if random-choice {
    say 'You were lucky.';
}

Function 'random-choice' needs parens to avoid gobbling block

Missing block (apparently claimed by 'random-choice')

class OutputCapture {
    has @!lines;
    method print(\s) {
        @!lines.push(s);
    }
    method captured() {
        @!lines.join;
    }
}

my class OutputCapture { ... }

my $c = OutputCapture.new;

my class OutputCapture {
    has @.lines;
    method print(\s) {
         # the private name with ! still works
         @!lines.push(s);
    }
    method captured() {
        @!lines.join;
    }
}
my $c = OutputCapture.new;
$c.print('42');
# use the `lines` accessor method:
say $c.lines; # Output: [42]

use v6;

my regex key { \w+ }

multi sub MAIN('test') {
    use Test;
    ok 'abc'     ~~ /^ <key> $/, '<key> matches a simple identifier';
    ok  '[abc]' !~~ /^ <key> $/, '<key> does not match a  section header';
    done-testing;
}

my regex value { <-[ \n ; ]>+ }

my regex value { <-[ \n ; ]>+ }
if ' abc ' ~~ /<value>/ {
    say "matched '$/'"; # matched ' abc '
}

my regex value {
    # match a first non-whitespace character
    <-[ \s ; ]>
    [
        # then arbitrarily many that can contain whitespace
        <-[ \n ; ]>*
        # ... terminated by one non-whitespace
        <-[ \s ; ]>
    ]?  # and make it optional, in case the value is only
        # only one non-whitespace character
}

my regex value { <!before \s> <-[ \n ; ]>+ <!after \s> }

is ' abc ' ~~ /<value>/, 'abc', '<value> does not match leading or trailing whitespace';
is ' a'    ~~ /<value>/, 'a',   '<value> matches single non-whitespace too';
ok "a\nb" !~~ /^ <value> $/,    '<value> does not match \n';

my regex value { <-[ \n ; ]>+ & \S.* & .*\S }

my regex pair { <key> '=' <value> }

my regex pair { <key> \h* '=' \h* <value> }

my regex pair { <key> \h* '=' \h* <value> \n+ }

ok "key=value\n" ~~ /<pair>/, 'simple pair';
ok "key = value\n\n" ~~ /<pair>/, 'pair with blanks';
ok "key\n= value\n" !~~ /<pair>/, 'pair with newline before assignment';

my regex header { '[' <-[ \[ \] \n ]>+ ']' \n+ }
# and in multi sub MAIN('test'):
ok "[abc]\n"    ~~ /^ <header> $/, 'simple header';
ok "[a c]\n"    ~~ /^ <header> $/, 'header with spaces';
ok "[a [b]]\n" !~~ /^ <header> $/, 'cannot nest headers';
ok "[a\nb]\n"  !~~ /^ <header> $/, 'No newlines inside headers';

my regex comment { ';' \N*\n+ }

my regex section {
    <header>
    [ <pair> | <comment> ]*
}

my regex inifile {
    [ <pair> | <comment> ]*
    <section>*
}

my regex block   { [ <pair> | <comment> ]* }
my regex section { <header> <block> }
my regex inifile { <block> <section>* }

my $ini = q:to/EOI/;
key1=value2

[section1]
key2=value2
key3 = with spaces

; comment lines start with a semicolon, and are
; ignored by the parser

[section2]
more=stuff
EOI

ok $ini ~~ /^<inifile>$/, 'Can parse a full INI file';

'abc' ~~ /.* b/

say "two words" ~~ /\w+\s*\w+/; # 「two words」

say "two" ~~ /\w+\s*\w+/; # 「two」

my token key     { \w+ }
my regex value   { <!before \s> <-[\n;]>+ <!after \s> }
my token pair    { <key> \h* '=' \h* <value> \n+ }
my token header  { '[' <-[ \[ \] \n ]>+ ']' \n+ }
my token comment { ';' \N*\n+ }
my token block   { [ <pair> | <comment> ]* }
my token section { <header> <block> }
my token inifile { <block> <section>* }

grammar IniFile {
    token key     { \w+ }
    token value   { <!before \s> <-[\n;]>+ <!after \s> }
    token pair    { <key> \h* '=' \h* <value> \n+ }
    token header  { '[' <-[ \[ \] \n ]>+ ']' \n+ }
    token comment { ';' \N*\n+ }
    token block   { [<pair> | <comment>]* }
    token section { <header> <block> }
    token TOP     { <block> <section>* }
}

my $result = IniFile.parse($text);

grammar IniFile {
    token ws { \h* }
    rule pair { <key>    '='    <value> \n+ }
    # rest as before
}

key1=value2

[section1]
key2=value2
key3 = with spaces
; comment lines start with a semicolon, and are
; ignored by the parser

[section2]
more=stuff

{
_ => {
          key1 => "value2"
      },
      section1 => {
          key2 => "value2",
          key3 => "with spaces"
      },
      section2 => {
          more => "stuff"
      }
}

token TOP { <block> <section>* }

token header { '[' ( <-[ \[ \] \n ]>+ ) ']' \n+ }
#                   ^^^^^^^^^^^^^^^^^^^^ a capturing group

sub parse-ini(Str $input) {
    my $m = IniFile.parse($input);
    unless $m {
        die "The input is not a valid INI file.";
    }

    sub block(Match $m) {
        my %result;
        for $m<block><pair> -> $pair {
            %result{ $pair<key>.Str } = $pair<value>.Str;
        }
        return %result;
    }

    my %result;
    %result<_> = block($m);
    for $m<section> -> $section {
        %result{ $section<header>[0].Str } = block($section);
    }
    return %result;
}

class IniFile::Actions {
    method key($/) { make $/.Str }
    method value($/) { make $/.Str }
    method header($/) { make $/[0].Str }
    method pair($/) { make $<key>.made => $<value>.made }
    method block($/) { make $<pair>.map({ .made }).hash }
    method section($/) { make $<header>.made => $<block>.made }
    method TOP($/) {
        make {
            _ => $<block>.made,
            $<section>.map: { .made },
        }
    }
}

sub parse-ini(Str $input) {
    my $m = IniFile.parse($input, :actions(IniFile::Actions));
    unless $m {
        die "The input is not a valid INI file.";
    }

    return $m.made
}

sub parse-ini(Str $input, :$rule = 'TOP') {
    my $m = IniFile.parse($input,
        :actions(IniFile::Actions),
        :$rule,
    );
    unless $m {
        die "The input is not a valid INI file.";
    }

    return $m.made
}

say parse-ini($ini).perl;

use Test;

is-deeply parse-ini("k = v\n", :rule<pair>), 'k' => 'v',
    'can parse a simple pair';
done-testing;

grammar IniFile {
    # regexes/tokens unchanged as before

    method parse-ini(Str $input, :$rule = 'TOP') {
        my $m = self.parse($input,
            :actions(IniFile::Actions),
            :$rule,
        );
    unless $m {
        die "The input is not a valid INI file.";
    }

    return $m.made
    }
}

# Usage:

my $result = IniFile.parse-ini($text);

class File {
    has $.name;
    has $.size;
    method total-size() { $.size }
}

class Directory {
    has $.name;
    has $.size;
    has @.children;
    has $!total-size;
    method total-size() {
        $!total-size //= $.size + @.children.map({.total-size}).sum;
    }
}

sub tree(IO::Path $path) {
    if $path.d {
        return Directory.new(
            name     => $path.basename,
            size     => $path.s,
            children => dir($path).map(&tree),
        );
    }
    else {
        return File.new(
            name => $path.Str,
            size => $path.s,
        );
    }
}

sub print-tree($tree, Int $indent = 0) {
    say ' ' x $indent, format-size($tree.total-size), ' ',
    $tree.name;

    if $tree ~~ Directory {
        print-tree($_, $indent + 2) for $tree.children;
    }
}

sub format-size(Int $bytes) {
    my @units = flat '', <k M G T P>;
    my @steps = (1, { $_ * 1024 } ... *).head(6);
    for @steps.kv -> $idx, $step {
        my $in-unit = $bytes / $step;
        if $in-unit < 1024 {
            return sprintf '%.1f%s', $in-unit, @units[$idx];
        }
    }
}

sub MAIN($dir = '.') {
    print-tree(tree($dir.IO));
}

$ zef install SVG

use SVG;
print SVG.serialize(
    :svg[
        width => 100,
        height => 20,
        title => [
            'example',
        ]
    ],
);

<svg xmlns="http://www.w3.org/2000/svg" xmlns:svg="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" width="100"
height="20"> <title>example</title>
</svg>

sub tree-map($tree, :$x1!, :$x2!, :$y1!, :$y2) {
    # do not produce rectangles for small files/dirs
    return if ($x2 - $x1) * ($y2 - $y1) < 20;

    # produce a rectangle for the current file or dir

    take 'rect' => [
        x => $x1,
        y => $y1,
        width  => $x2 - $x1,
        height => $y2 - $y1,
        style  => "fill:" ~ random-color(),
        title  => [$tree.name],
    ];
    return if $tree ~~ File;

    if $x2 - $x1 > $y2 - $y1 {
        # split along the x-axis
        my $base = ($x2 - $x1) / $tree.total-size;
        my $new-x = $x1;
        for $tree.children -> $child {
            my $increment = $base * $child.total-size;
            tree-map(
                $child,
                x1 => $new-x,
                x2 => $new-x + $increment,
                :$y1,
                :$y2,
            );
            $new-x += $increment;
        }
    }
    else {
        # split along the y-axis
        my $base = ($y2 - $y1) / $tree.total-size;
        my $new-y = $y1;
        for $tree.children -> $child {
            my $increment = $base * $child.total-size;
            tree-map(
                $child,
                :$x1,
                :$x2,
                y1 => $new-y,
                y2 => $new-y + $increment,
            );
            $new-y += $increment;
         }
    }
}

sub random-color {
    return 'rgb(' ~ (1..3).map({ (^256).pick }).join(',') ~ ')';
}

sub MAIN($dir = '.') {
    my $tree = tree($dir.IO); use SVG;
    my $width = 1024;
    my $height = 768;
    say SVG.serialize(
        :svg[
            :$width,
            :$height,
            | gather tree-map $tree, x1 => 0, x2 => $width, y1 => 0,
            y2 => $height
        ]
    );
}

sub flame-graph($tree, :$x1!, :$x2!, :$y!, :$height!) {
    return if $y >= $height;
    take 'rect' => [
        x => $x1,
        y => $y,
        width => $x2 - $x1,
        height => 15,
        style => "fill:" ~ random-color(),
        title => [$tree.name ~ ', ' ~ format-size($tree.total-size)],
    ];

    return if $tree ~~ File;

    my $base = ($x2 - $x1) / $tree.total-size;
    my $new-x = $x1;

    for $tree.children -> $child {
        my $increment = $base * $child.total-size;
        flame-graph(
            $child,
            x1 => $new-x,
            x2 => $new-x + $increment,
            y => $y + 15,
            :$height,
        );
        $new-x += $increment;
    }
}

sub MAIN($dir = '.', :$type="flame") {
    my $tree = tree($dir.IO);
    use SVG;
    my $width = 1024;
    my $height = 768;
    my &grapher = $type eq 'flame'
            ?? { flame-graph $tree, x1 => 0, x2 => $width, y => 0, :$height }
            !! { tree-map    $tree, x1 => 0, x2 => $width, y1 => 0, y2 => $height }
    say SVG.serialize(
        :svg[
            :$width,
            :$height,
            | gather grapher()
        ]
    );
}

sub subdivide($tree, $lower, $upper, &todo) {
    my $base = ($upper - $lower ) / $tree.total-size;
    my $var = $lower;
    for $tree.children -> $child {
        my $incremented = $var + $base * $child.total-size;
        todo($child, $var, $incremented);
        $var = $incremented,
    }
}

sub flame-graph($tree, :$x1!, :$x2!, :$y!, :$height!) {
    return if $y >= $height;
    take 'rect' => [
        x => $x1,
        y => $y,
        width  => $x2 - $x1,
        height => 15,
        style => "fill:" ~ random-color(),
        title => [$tree.name ~ ', ' ~ format-size($tree.total-size)],
    ];
    return if $tree ~~ File;
    subdivide( $tree, $x1, $x2, -> $child, $x1, $x2 {
        flame-graph( $child, :$x1, :$x2, :y($y + 15), :$height );
    });
}

sub tree-map($tree, :$x1!, :$x2!, :$y1!, :$y2) {
    return if ($x2 - $x1) * ($y2 - $y1) < 20;
    take 'rect' => [
        x => $x1,
        y => $y1,
        width  => $x2 - $x1,
        height => $y2 - $y1,
        style  => "fill:" ~ random-color(),
        title  => [$tree.name],
    ];
    return if $tree ~~ File;

    if $x2 - $x1 > $y2 - $y1 {
        # split along the x-axis
        subdivide $tree, $x1, $x2, -> $child, $x1, $x2 {
            tree-map $child, :$x1, :$x2, :$y1, :$y2;
        }
    }
    else {
        # split along the y-axis
        subdivide $tree, $y1, $y2, -> $child, $y1, $y2 {
            tree-map $child, :$x1, :$x2, :$y1, :$y2;
        }
    }
}

subdivide( $tree, $x1, $x2, -> $child, $x1, $x2 {
    flame-graph( $child, :$x1, :$x2, :y($y + 15), :$height );
});

sub svg-tree-gen(:&terminate!, :&base-height!, :&subdivide-x!, :&other!) {
    sub inner($tree, :$x1!, :$x2!, :$y1!, :$y2!) {
        return if terminate(:$x1, :$x2, :$y1, :$y2);
        take 'rect' => [
            x => $x1,
            y => $y1,
            width  => $x2 - $x1,
            height => base-height(:$y1, :$y2),
            style  => "fill:" ~ random-color(),
            title  => [$tree.name ~ ', ' ~ format-size($tree.total-size)],
        ];
        return if $tree ~~ File;
        if subdivide-x(:$x1, :$y1, :$x2, :$y2) {
            # split along the x-axis
            subdivide $tree, $x1, $x2, -> $child, $x1, $x2 {
                inner($child, :$x1, :$x2, :y1(other($y1)), :$y2);
            }
        }

        else {
            # split along the y-axis
            subdivide $tree, $y1, $y2, -> $child, $y1, $y2 {
                inner($child, :x1(other($x1)), :$x2, :$y1, :$y2);
            }
        }
    }
}

my &flame-graph = svg-tree-gen
    terminate => -> :$y1, :$y2, | { $y1 > $y2 },
    base-height => -> | { 15 },
    subdivide-x => -> | { True },
    other => -> $y1 { $y1 + 15 },
    ;

my &tree-map = svg-tree-gen
    terminate => -> :$x1, :$y1, :$x2, :$y2 { ($x2 - $x1) * ($y2 - $y1) < 20 },
    base-height => -> :$y1, :$y2 { $y2 - $y1 },
    subdivide-x => -> :$x1, :$x2, :$y1, :$y2 { $x2 - $x1 > $y2 - $y1 },
    other => -> $a { $a },
    ;

my &grapher = $type eq 'flame' ?? &flame-graph !! &tree-map;
say SVG.serialize(
    :svg[
        :$width,
        :$height,
        | do gather grapher $tree, x1 => 0, x2 => $width, y1 => 0, y2 => $height
    ]
);

my &flame-graph = svg-tree-gen
    base-height => -> | { 15 },
    other => -> $y1 { $y1 + 16 },
    # rest as before

sub svg-tree-gen(
    :&color=&random-color,
    :&terminate!,
    :&base- height!,
    :&subdivide-x!,
    :&other!) {
    sub inner($tree, :$x1!, :$x2!, :$y1!, :$y2!) {
        return if terminate(:$x1, :$x2, :$y1, :$y2);
        take 'rect' => [
            x => $x1,
            y => $y1,
            width  => $x2 - $x1,
            height => base-height(:$y1, :$y2),
            style  => "fill:" ~ color(),
            title  => [$tree.name ~ ', ' ~ format-size($tree.total-size)],
    }
];
# rest as before
}

sub color-range(|) {
    state ($r, $g, $b) = (0, 240, 120);
    $r = ($r + 5) % 256;
    $g = ($g + 10) % 256;
    $b = ($b + 15) % 256;
    return "rgb($r,$g,$b)";
}

method total-size() {
    $!total-size //= $.size + @.children.map({.total-size}).sum;
    #                                        ^^^^^^^^^^^^^
}

method total-size() {
    $!total-size //= $.size + @.children.map(*.total-size).sum;
}

role Path {
    has $.name;
    has $.size;
    method total-size() { ... }
}

class File does Path {
    method total-size() { $.size }
}

class Directory does Path {
    has @.children;
    has $!total-size;
    method total-size() {
        $!total-size //= $.size + @.children.map(*.total-size).sum;
    }
}

enum GraphType <flame tree>;

sub MAIN($dir = '.', GraphType :$type=flame) {
    my $tree = tree($dir.IO);
    use SVG;
    my $width = 1024;
    my $height = 768;
    my &grapher = $type == flame ?? &flame-graph !! &tree-map;
    say SVG.serialize(
        :svg[
            :$width,
            :$height,
            | do gather grapher $tree, x1 => 0, x2 => $width, y1 => 0, y2 => $height
        ]
    );
}

my $s = "ø\c[COMBINING TILDE]"; say $s; # Output: ø̃
say $s.chars; # Output: 1

my $bytes = 'Raku'.encode('UTF-8'); # utf8:0x<50 65 72 6c 20 36>

$*OUT.write('Raku'.encode('UTF-8'));

say ٤٢; # 42

say "٤٢".Int; # 42

say "\c[TIBETAN DIGIT HALF ZERO]".unival;

say "ø".uniprop;                           # Ll
say "\c[TIBETAN DIGIT HALF ZERO]".uniprop; # No

say "a".uniprop-bool('ASCII_Hex_Digit'); # True
say "ü".uniprop-bool('Numeric_Type');    # False
say ".".uniprop("Word_Break");           # MidNumLet

my @list = <a ö ä Ä o ø>;
say @list.sort;                    # (a o Ä ä ö ø)

use experimental :collation;
say @list.collate;                 # (a ä Ä o ö ø)

$*COLLATION.set(:tertiary(False));
say @list.collate;                 # (a Ä ä o ö ø)

my $proc = run :out, <git log --date=short --pretty=format:%ad!%an>;
my (%total, %by-author, %dates);
for $proc.out.lines -> $line {
    my ( $date, $author ) = $line.split: '!', 2;
    %total{$author}++;
    %by-author{$author}{$date}++;
    %dates{$date}++;
}

my @top-authors = %total.sort(-*.value).head(5).map(*.key);

my @dates = %by-author{$author}.keys.sort;
my @counts = %by-author{$author}{@dates};

import datetime
import matplotlib.pyplot as plt
fig, subplots = plt.subplots()
subplots.plot(
    [datetime.date(2017, 1, 5), datetime.date(2017, 3, 5),
    datetime.date(2017, 5, 5)],
    [ 42, 23, 42 ],
    label='An example',
)

subplots.legend(loc='upper center', shadow=True)
fig.autofmt_xdate()
plt.show()

$ zef install Inline::Python

use Inline::Python;

my $py = Inline::Python.new;
$py.run: 'print("Hello, Raku")';

use Inline::Python;

my $py = Inline::Python.new;
$py.run('import datetime');
my $date = $py.call('datetime', 'date', 2017, 1, 31);
$py.call('__builtin__', 'print', $date); # 2017-01-31

say $date.isoformat().decode; # 2017-01-31

say $date.year;

'int' object is not callable

say $py.call('__builtin__', 'getattr', $date, 'year');

my $py = Inline::Python.new;
$py.run('import datetime');
$py.run('import matplotlib.pyplot');
sub plot(Str $name, |c) {
    $py.call('matplotlib.pyplot', $name, |c);
}

sub pydate(Str $d) {
    $py.call('datetime', 'date', $d.split('-').map(*.Int));
}

my ($figure, $subplots) = plot('subplots');
$figure.autofmt_xdate();

my @dates = %dates.keys.sort;

$subplots.plot:
    $[@dates.map(&pydate)],
    $[ %dates{@dates} ],
    label     => 'Total',
    marker    => '.',
    linestyle => '';

for @top-authors -> $author {
    my @dates = %by-author{$author}.keys.sort;
    my @counts = %by-author{$author}{@dates};
    $subplots.plot:
        $[ @dates.map(&pydate) ],
        $@counts,
        label     => $author,
        marker    =>'.',
        linestyle => '';
}

$subplots.legend(loc=>'upper center', shadow=>True);
plot('title', 'Contributions per day');
plot('show');

my @dates = %dates.keys.sort;
my @stack = $[] xx @top-authors;

for @dates -> $d {
    for @top-authors.kv -> $idx, $author {
        @stack[$idx].push: %by-author{$author}{$d} // 0;
    }
}

$subplots.stackplot($[@dates.map(&pydate)], @stack);
plot('title', 'Contributions per day');
plot('show');

my @dates = %dates.keys.sort;

my @dates = %dates.keys.minmax;

my @dates = %dates.keys.sort;
my @stack = $[] xx @top-authors;
my @bottom = $[] xx @top-authors;

for @dates -> $d {
    my $bottom = 0;
    for @top-authors.kv -> $idx, $author {
        @bottom[$idx].push: $bottom;
        my $value = %by-author{$author}{$d} // 0;
        @stack[$idx].push: $value;
        $bottom += $value;
    }
}

my $width = 1.0;
my @colors = <red green blue yellow black>;
my @plots;

for @top-authors.kv -> $idx, $author {
    @plots.push: plot(
        'bar',
        $[@dates.map(&pydate)],
        @stack[$idx],
        $width,
        bottom => @bottom[$idx],
        color => @colors[$idx],
        edgecolor => @colors[$idx],
    );
}
plot('legend', $@plots, $@top-authors);

plot('title', 'Contributions per day');
plot('show');

multi sub MAIN(Str $date where /^ \d+ \- \d+ \- \d+ $ /) { ... }

subset DateStr of Str where /^ \d+ \- \d+ \- \d+ $ /;

multi sub MAIN(DateStr $date) { ... }
sub parse-date(DateStr) returns Date { ... }

use Cro::HTTP::Router;
use Cro::HTTP::Server;

my $application = route {
    get -> 'datetime', Int $timestamp {
        my $dt = DateTime.new($timestamp);
        content 'text/plain', "$dt\n";
    }
}

my $port = 8080;
my Cro::Service $service = Cro::HTTP::Server.new(
    :host<0.0.0.0>,
    :$port,
    :$application,
);

$service.start;
say "Application started on port $port";
react whenever signal(SIGINT) { $service.stop; done; }

react whenever signal(SIGINT) { $service.stop; done; }

signal(SIGINT).merge(signal(SIGTERM))

$ zef install --/test cro Cro::HTTP::Test

$ docker run --rm --publish 8080:8080 -v $PW/raku -w /raku \
    -it moritzlenz/raku-fundamentals raku datetime.p6

$ curl http://127.0.0.1:8080/datetime/1578135634
2020-01-04T11:00:34Z

my token date-re {
    ^
    \d**4 '-' \d**2 '-' \d** 2 # date part YYYY-MM-DD
    [
    ' '
    \d**2 ':' \d**2 ':' \d**2  # time
    ]?
    $
}

my $application = route {
    get -> 'datetime', Int $timestamp {
        my $dt = DateTime.new($timestamp);
        content 'text/plain', "$dt\n";
    }

    get -> 'datetime', Str $date_spec where &date-re {
        my ( $date_str, $time_str ) = $date_spec.split(' ');
        my $date = Date.new($date_str);

        my $datetime;
        if $time_str {
            my ( $hour, $minute, $second ) = $time_str. split(':');
            $datetime = DateTime.new( :$date, :$hour, :$minute, :$second );
        }
        else {
            $datetime = $date.DateTime;
        }
        content "text/plain", $datetime.posix ~ "\n";
    }
}

get -> 'datetime', Str $date_spec where &date-re { ... }

$ curl http://127.0.0.1:8080/datetime/2020-01-04%2011:00:34
1578135634

# in the first route
content 'application/json', {
    input => $timestamp,
    result => $dt.Str,
}
# in the second route
content "application/json", {
    input => $date_spec,
    result => $datetime.posix,
}

sub routes() {
    return route {
        # same route definitions as before
    }
}

multi sub MAIN(Int :$port = 8080, :$host = '0.0.0.0') {
    my Cro::Service $service = Cro::HTTP::Server.new(
        :$host
        :$port,
        application => routes(),
    );
    $service.start;
    say "Application started on port $port";
    react whenever signal(SIGINT) { $service.stop; done; }
}

multi sub MAIN('test') {
    use Cro::HTTP::Test;
    use Test;
    test-service routes(), {
        test get('/datetime/1578135634'),
            status => 200,
            json => {
                result => "2020-01-04T11:00:34Z",
                input => 1578135634 ,
            };
        test get('/datetime/2020-01-04%2011:00:34'),
            status => 200,
            json => {
                input => '2020-01-04 11:00:34',
                result => 1578135634,
            };

    }
    done-testing;
}

$ raku datetime.p6 test
    ok 1 - Status is acceptable
    ok 2 - Content type is recognized as a JSON one
    ok 3 - Body is acceptable
    1..3
ok 1 - GET /datetime/1578135634
    ok 1 - Status is acceptable
    ok 2 - Content type is recognized as a JSON one
    ok 3 - Body is acceptable
    1..3
ok 2 - GET /datetime/2020-01-04%2011:00:34
1..2

get -> { static 'index.html'; }
get -> 'index.js' { static 'index.js'; }

<html>
<head>
<title>Datetime to UNIX timestamp conversion</title>
<script
    src="https://code.jquery.com/jquery-3.5.1.min.js"
    crossorigin="anonymous"></script>
<script type="text/javascript" src="/index.js"></script>
</head>

<body>
<h1>Convert UNIX timestamp to ISO datetime or vice versa</h1>
<form>
<label for="in">Input</label>
<input name="in" id="in" placeholder="2014-01-14 10:12:00"></input>
<button id="submit">Submit</button>
</form> <h2>Result</h2>
<ul id="result"></ul>
</body>
</html>

$(document).ready(function() { $('#submit').click(function(event) {
var val = $('#in').val();
$.get('/datetime/' + val, function(response) {
            $('#result').append(
                '<li>Input: ' + val +
                ', Result: ' + response['result'] +
                '</li>');
});
        event.preventDefault();
    });
});

get -> 'datetime', Int $timestamp { ... }

get(-> 'datetime', Int $timestamp { ... });

get( sub ('datetime', Int $timestamp) { ... } )

sub convert-from-timestamp('datetime', Int $timestamp) {
    my $dt = DateTime.new($timestamp);
    content 'application/json', {
        input => $timestamp,
        result => $dt.Str,
    }
}

sub convert-from-isodate('datetime', Str $date_spec where &date-re) {
    # omitted for brevity
}

my $application = route {
    get &convert-from-timestamp;
    get &convert-from-isodate;
}

my @params = &convert-from-timestamp.signature.params;
say @params.elems;
say @params[0].type;
say @params[0].constraints;
# => 2
# => (Str)
# => all(datetime)

my &d = dispatcher {
    on -> Str  $x { say "String $x" }
    on -> Date $x { say "Date $x"   }
}

d(Date.new('2020-12-24'));
d("a test");

sub dispatcher(&body) {
    my @*CASES;
    body();
    my @cases = @*CASES;
    return sub (Mu $x) {
        for @cases -> &case {
            if $x ~~ &case.signature.params[0].type {
                return case($x)
            }
        }
        die "No case matched $x";
    }
}

sub on(&case) {
    die "Called on() outside a dispatcher block"
        unless defined @*CASES;
    unless &case.signature.params == 1 {
        die "on() expects a block with exactly one parameter"
    }
    @*CASES.push: &case;
}