Typed filters

The Discord Raku bot is now also an IRC -> Discord bridge. To handle the streams of messages I use a react-block with a few whenevers. I would like to handle filtering of debug output from API::Discord in there as well, without disrupting something simple like printing to the terminal.

In my last post I showed how I can control the behaviour of a module with the use statement. The next step is to divert writes to $*ERR to a Supply.

my $active = False;

sub debug-print(|c) {
    $*ERR.print: |c if $active;
}

sub debug-print-supply(Supply $in? --> Supply:D) {
    my $result = $in // Supplier::Preserving.new;

    &debug-print.wrap(-> |c {
        $result.emit: |c
    });

    $result.Supply
}

multi sub EXPORT('FROM-MODULE') {
    %(
        '&debug-print' => &debug-print,
    )
}

multi sub EXPORT() {
    $active = True;

    %(
        '&debug-print' => &debug-print-supply,
    )
}

As long as the user of the module doesn’t call debug-print, we have the simple case of writing to $*ERR. When debug-print is called, we divert the stream into a Supply. If no Supply is supplied, we create one. To be able to filter output a role is created in API::Discord::Debug.

role LogEventType is export {}

This role is indeed empty and so are the roles that are created to provide filters.

unit module Testmodule;

use API::Discord::Debug <FROM-MODULE>;

role HEARTBEAT does LogEventType is export {}
role PING does HEARTBEAT does LogEventType is export {}

start loop {
    sleep ¼;
    debug-print("ping" but PING);
    debug-print("pong" but PONG) unless 10.rand < 2;
}

So we create a Str and mixin a role, what is a type object we can check against.

use API::Discord::Debug;
use Testmodule;

react {
    my  $pings = 0;

    whenever debug-say().merge(debug-print()) {
        when PING { $pings++; }
        when PONG { $pings--; }
        default { .note }
    }

    whenever Supply.interval(5) {
        say „$pings heartbeats are lost“ if $pings > 1;
    }
}

Mixing in an empty role wont upset any unsuspecting bystander and type checks compose well. Here I use them with when/default, a multi dispatch would work as well. Introspection can be done with .WHAT.say.

On CPAN we can find many “complete” modules that kill a specific problem once and for all. For many of those, there tends to be another module suffixed with ::Simple. Simple stuff should be simple because we can’t buy any more days in this life. We also don’t take anything with us. I hope I can leave something simple behind instead.

Being pragmat-ish

The question was raised if one can provide a custom pragma. As it happens, today I needed just that. API::Discord is a bit chatty. It is outputting debug and status info right to the terminal. Since I got the Discord bot now also being an IRC bot, the clutter got a bit much. My first thought was to wrap note and warn to filter messages out I don’t want. But there is also $*ERR.print in the mix. So I went and meta6 --fork-module=API::Discord.

The goal is to use API::Discord::Debug; to change the behaviour of the module. That is what a pragma does. It changes the way how the compiler or the runtime work. I also want two subs to make the whole thing .wrap-able, to allow feeding the debug output into a Supply.

use v6.d;

my $active = False;

sub debug-print(|c) {
    $*ERR.print: |c if $active;
}

sub debug-say(|c) {
    $*ERR.say: |c if $active;
}

multi sub EXPORT('FROM-MODULE') {
    %(
        '&debug-print' => &debug-print,
        '&debug-say' => &debug-say,
    )
}

multi sub EXPORT() {
    $active = True;
    %()
}

The trick is to have to multi sub EXPORT so we can do use API::Discord::Debug to switch debugging output on and use API::Discord::Debug <FROM-MODULE> to get two functions exported to be called in the various .rakumod-files of the distribution.

We can’t really define custom pragmas. But use is kindly calling a function we can define, to get at least some of the behaviour we need.

Despotting

API::Discord is a bit spotty. Many classes that are typically represented as a Str don’t sport that method. In same cases bare deparsed JSON is returned. That led to a fair amount of clutter that followed a pattern. After making a remote call via the API, I mix in a role and query the API further, before passing a list on via a Supply. I do the same operation with different operants. That’s sounds like a candidate for a multi sub.

multi sub augment(Discord::Channel $s) {
    $s does role :: {
        method Str { ‚#‘ ~ self.name }
    }
}

multi sub augment(%author where { .<discriminator>:exists }, API::Discord:D $discord) {
    $discord.get-user(%author<id>) does role :: {
        method Str { self.username ~ '#' ~ self.discriminator }
    }
}

multi sub augment(API::Discord::User $user) {
    $user does role :: {
        method Str { self.username ~ '#' ~ self.discriminator }
    }
}

# [...]

    start react {
        whenever $discord.ready {
            note "Logged in as { $discord.user.username }.";
        }
        whenever $discord.messages -> $message {
            next unless $channels ~~ $message.channel.name;

            $result.emit: [ $message.channel.&augment, $message.author.&augment, $message.content ];
        }
        whenever $discord.events -> $event {
            if $event<t> eq 'MESSAGE_UPDATE' {
                my $m = $event<d>;
                my $channel = $discord.get-channel($m<channel_id>).&augment;
                my $author = $m<author>.&augment($discord);
                next unless $channels ~~ $channel;

                $result.emit: [ $channel, $author, $m<content>, :update ];
            }
        }
        CATCH { default { say .^name ␣ .Str } }
    }

Simply calling augment as a pseudo-method will fix the shortcomings. If the API is changes I only have to accommodate that change in a single place in my program. Raku makes it very convenient to deal with an inconvenience. One might think Raku is British. Time to make some tea.

Matching nothing

I requested and foolishly offered help with a Discord log bot to lizmat. While doing so I stumbled upon a neat use for none().

sub discord-log-stream(Mu:D :$channels is copy = %*ENV<DISCORD-CHANNELS> // none()) {
    $channels = $channels.split('#', :skip-empty).any;

    # ...

    start react {
        whenever $discord.messages -> $message {
            next unless $channels ~~ $message.channel.name;

            $result.emit: [ ‚#‘ ~ $message.channel.name, $message.author.&{ .username ~ ‚#‘ ~ .discriminator }, $message.content ];
        }
    }
}

If no channel list is given, the bot shall log all channels. Instead of special casing, I use an empty none-Junction as a default value. With channels to include, $channel contains an any-Junction of Str. Matching a single Str with ~~ will return True if the string is also in the any-Junction. Any test against none() will return True. So my default value will always test True. This is a little bit like matching against the inverse of the empty set.

As it happens none() is quite resilient. It survives both .split and .any. Being an instance of Junction makes it defined. That is helpful because it allows the :D-type smiley and as such guards against undefined values.

Given that none() is everything I would not wonder if one who masters Raku goes straight to निर्वाण.

Update:

Since none() is anything but obvious, adding a constant with a speaking name adds clarity.

constant all-channels := none();

sub discord-log-stream(Mu:D :$channels is copy = %*ENV<DISCORD-CHANNELS> // all-channels) {
    # ...
}

Teaching on a waterbed

After watching Raku, the Big by Bruce Gray I can only agree with the assessment of how difficult it is to teach Raku to a beginner. I have been a Raku beginner myself since 2010. And that means learning the language can’t be hard. After all, even I managed. I had the Synopsis and IRC. The docs were pretty spotty and in some places outdated already (thanks to the GLR). Since there were no books or guides, the best I could do was start coding and asking questions. I’m quite happy with the result.

Things changed when I started to blog in earnest. With all those holes in the docs I had a lot of explaining to do. Let’s look at some code.

my &b = { 42 }; &b.say;
# OUTPUT: -> ;; $_? is raw = OUTER::<$_> { #`(Block|94577606390984) ... }

It’s just a block that returns 42. To explain the output I have to cover return values, default signatures, the topic, optional positional arguments, containers (one can’t explain the absence of a container without containers), default values and pseudo packages. And with all that I still skip my &b =.

I consider myself lucky, that as a beginner, I don’t need to know most of that stuff, before I can start coding. While looking at our website, one can only conclude, that being asked questions by beginners isn’t all the welcome. The link named “getting started” could be named better and be bigger.

We do have live logs now for IRC (logs for Discord have been requested). I can’t see any reason why they shouldn’t be placed prominently on the front page. Our chat channels are the entry point to the community. There is no reason to hide them (or us).

Bruce is right in asking for improvement, there is plenty of room for that. But the perspective of the educator is the wrong starting point. A linear course doesn’t work because of all the complexity hidden behind the defaults. Getting some order into a host of topics can’t hurt. Also, why is that an external link?

The community was my gateway to Perl 6Raku. I would love to see more help for folk with the same learning deficiency then I got.

Late early bound

My last post got at least two people thinking. I made the suggestion to add a sub called pretty-print to make the resulting text/html human friendly. Since this is a nice name, making it a multi seams a polite move.

multi sub pretty-print(html::("NON-QUOTE") $html) { ... }

Since html is a singleton of an anonymous class, we can’t easily refer to the role NON-QUOTE within. We use a runtime lookup to get hold of the type at compile time. Said compile time is actually quite late. It happens at the same time constants are evaluated. Hence, html‘s guts can be queried, because that constant expression is further up in the file.

I did not know that type constraints are turned into type objects that late and found it difficult to explain. We may have to invent time travel to learn the time traveller language to be able to explain the order of operations of Rakudo.

Low profile quoting

I wrote a program that got exactly one user that is not me and is used once a week. Hence, I can proudly claim to be 520% efficient. The result can be found at the bottom of each Raku Weekly News. While casting my Raku spells I once again had felt the urge for a simply but convenient way to inline fragments of html in code. The language leans itself to the task with colon pairs and slurpy arrays.

sub a(*@a, *%_) { ... }

a(:href<www.somewhere.tld>, child(...), 'bare string');

I don’t want o pull in lots of names into the local namespace and avoiding a module would be nice. For a simple shellish script unusual dependencies are best avoided. At first I tried to abuse packages but those are compile time creatures and I don’t fancy to pre-define all possible html tags. But a package in the end is just a Stash is a Map is a Hash. Building a simple dynamic Hash-like is quite easy.

constant term:<␣> = ' ';
constant term:<¶> = $?NL;

constant html = class :: does Associative {
    sub qh($s) {
        $s.trans([ '<'   , '>'   , '&' ] =>
                 [ '&lt;', '&gt;', '&amp;' ])
    }

    role NON-QUOTE {}

    method AT-KEY($key) {
        sub (*@a, *%_) {
            ('<' ~ $key ~ (+%_ ?? ␣ !! '') ~ %_.map({ .key ~ '="' ~ .value ~ '"'  }).join(' ') ~ '>' ~
            @a.map( -> \e { e ~~ NON-QUOTE ?? e !! e.&qh }).join('') ~
            '</' ~ $key ~ '>') does NON-QUOTE
        }
    }
}

put html<a>(:href<www.foo.bar>, html<em>('<person@domain.top>'), 'M&M');

Here we got a singleton of a class that does Associative and as such will react nicely to <> and {} subscripts. It will quote bare strings because the anonymous sub will mark its output with the empty role NON-QUOTE. Anything returned from that sub is HTML and as such doesn’t need quoting. Bare string will not be returned by that sub, resulting in them being quoted.

This snippet is short enough to be covered by fair use — even by German standards — so please feel free to use it.

UPDATE:

HTML-entities must not be quoted too and never have arguments. Since we can tell them apart by the & at the beginning, we can return something different from the hash-like.

constant html = class :: does Associative {
    sub qh($s) {
        $s.trans([ '<'   , '>'   , '&' ] =>
                 [ '&lt;', '&gt;', '&amp;' ])
    }

    role NON-QUOTE {}

    method AT-KEY($key) {
        when $key ~~ /^ '&' / {
            $key does NON-QUOTE
        }
        when $key ~~ /\w+/ {
            sub (*@a, *%_) {
                dd @a;
                ('<' ~ $key ~ (+%_ ?? ␣ !! '') ~ %_.map({ .key ~ '="' ~ .value ~ '"'  }).join(' ') ~ '>' ~
                @a.map( -> \e { e ~~ NON-QUOTE ?? e !! e.&qh }).join('') ~
                '</' ~ $key ~ '>') does NON-QUOTE
            }
        }
    }
}

put html<a>(:href<www.foo.bar>, html<em>('<person@domain.top>'), html<&nbsp;>, 'M&M');
put html<&nbsp;>;