Adjective Noun

Page 2

Pick and Choose (Part 1)

2018-03-05 11:30, Tags: combinatorics

My recent obsession has been around combinatorics. For those of you who may be unfamiliar, combinatorics is a branch of mathematics closely related to graph theory. If I had to explain it in a short sentence, I'd probably say it's about the different ways in which a set of elements can be enumerated or constructed. That's a gross generalisation, but it will do for now.

There are a whole host of combinatoric algorithms, and Perl 6 has 2 of them in the core language: permutations and combinations. There's good reason why just those 2... They are among the most common, and most useful, but that's not to say the other's aren't useful, and when I found myself needing one of those other algorithms, it led me on my aforementioned obsession.

The first one I want to talk about is "combinations with repetitions". This algorithm could be described as... At a given ice cream shop, how many different ways can I order 2 scoops. Order of choices doesn't matter, so 'Vanilla and Chocolate' is the same as 'Chocolate and Vanilla'

As a general rule, when order doesn't matter, you're talking combinations. When order matters, you're talking permutations

Now, there exists a way to do this in Perl 6 on RosettaCode, but I want to state that I did come up with a solution by myself first based on a something I read in the Python documentation, and it also helped me later realise that - upon seeing it - the RosettaCode snippet was incorrect.

So back to Python for a minute... It has a combinations_with_replacement function in the itertools core module. Lets see what it looks like.

>>> from itertools import *
>>> list(combinations_with_replacement('ABCD', 2))
[('A', 'A'), ('A', 'B'), ('A', 'C'), ('A', 'D'), ('B', 'B'),
 ('B', 'C'), ('B', 'D'), ('C', 'C'), ('C', 'D'), ('D', 'D')]

In the itertools documentation for this function, it mentions that the result can be "expressed as a subsequence of product() after filtering entries where the elements are not in sorted order". In Perl 6, using the cross (Cartesian product) meta-operator ([X]), I came up with this nifty one-liner.

> sub cwr(@l, $k) { ([X] ^@l xx $k).unique(:as(~*.sort)).map({ @l[|$_] }) }
> cwr(<A B C D>, 2)
((A A) (A B) (A C) (A D) (B B) (B C) (B D) (C C) (C D) (D D))

I started by creating $k copies of my list indices, then create a Cartesian product of those lists, keeping unique ones (based on the stringified sorted order). I then use those indices to get the elements from the original list.

For the couple of benchmarks I ran (on admittedly small datasets), doing .unique(:as(~*.sort)) was slightly faster than doing something like .grep({ [≤] $_ }). In a pinch, this little snippet will do the trick, but it's also quite clear that I'm generating a bunch of data that I just throw away, so it can never be truly efficient.

Now take a look at the Perl 6 snippet on RosettaCode for comparison. At the time of writing, it looked like this.

[X](@S xx $k).unique(as => *.sort.cache, with => &[eqv])

It certainly looks similar enough, and initially when I tried it out it seemed to work... However I quickly realised it had a flaw.

> sub ros(@S, $k) { [X](@S xx $k).unique(as => *.sort.cache, with => &[eqv]) }
> ros([0,1,2,3], 2)
((0 0) (0 1) (0 2) (0 3) (1 1) (1 2) (1 3) (2 2) (2 3) (3 3))
> ros([1,1,1,1], 2)
((1 1))
> cwr([1,1,1,1], 2)
((1 1) (1 1) (1 1) (1 1) (1 1) (1 1) (1 1) (1 1) (1 1) (1 1))

And here's Python just for good measure

>>> list(combinations_with_replacement([1,1,1,1], 2))
[(1, 1), (1, 1), (1, 1), (1, 1), (1, 1), (1, 1), (1, 1), (1, 1), (1, 1), (1, 1)]

Now I suppose you could argue that it's a combination, so order doesn't matter, but to push my ice cream analogy... Say your ice cream shop only has one flavour, but it has four buckets of that flavour. This algorithm is concerned with the different ways you can take two scoops in terms of which buckets you scoop from, so this RosettaCode snippet is slightly broken.

There's also a recursive version on RosettaCode, which I've included below.

proto combs_with_rep(UInt, @) {*}
multi combs_with_rep(0,  @) { () }
multi combs_with_rep(1,  @a) { map { $_, }, @a }
multi combs_with_rep($,  []) { () }
multi combs_with_rep($n, [$head, *@tail]) {
    |combs_with_rep($n - 1, ($head, |@tail)).map({ $head, |@_ }),
    |combs_with_rep($n, @tail);
}

say combs_with_rep(2, [1, 1, 1, 1]);

# OUTPUT: ((1 1) (1 1) (1 1) (1 1) (1 1) (1 1) (1 1) (1 1) (1 1) (1 1))

Apart from the minor difference of taking the list as the second argument, this function performs correctly, but it's slower than my one-liner (at least in the few benchmarks I ran).

I committed to finding a faster and more efficient algorithm. Most of the other snippets on RosettaCode were recursive functions. I knew that iterative code was generally more performant than recursive, so I kept looking for a iterative solution. I noticed the C++ version, and converted it to Perl 6. It was faster, but eventually I came upon another algorithm which - when converted to Perl 6 - benched even faster.

I'm sure those of you of the more Computer Science persuasion could have told me where to look, but several sites referenced Donald Knuth's The Art of Computer Programming books. Specifically, "Fascicle 2: Generating All Tuples and Permutations" and "Fascicle 3: Generating All Combinations and Partitions". I had a look and it seems the books don't straight-up give you some code, but rather more-or-less describe an algorithm. I suspect most the algorithms in use for this sequence are interpretations of the algorithm described.

So far, the fastest algorithm I found (as far as pure Perl 6 benchmarks are concerned) is the following

sub cwr(@list, int $k) {
    gather {
        my @idx = 0 xx $k;
        take @list[@idx];
        my int $e = @list.end;
        loop {
            if @idx[$k - 1] < $e {
                @idx[$k - 1]++;
            }
            else {
                loop (my int $j = $k - 2; $j0; $j--) {
                    last if @idx[$j] != $e;
                }
                last if $j < 0;
                @idx[$j]++;
                loop ($j += 1; $j < $k; $j++) {
                    @idx[$j] = @idx[$j - 1];
                }
            }
            take @list[@idx];
        }
    }
}

This algorithm does not take into account what should happen when $k ≤ 0 or @list is empty, but those can be added fairly trivially. Upon gazing at this code, your first thought might be "Egads man! Why are you using c-style loops", and the reason should be obvious. I benched it and it was faster than using a Range.

So far, this is the fastest algorithm I benched in pure Perl 6, but can it go faster? It can if we move beyond pure Perl 6, and into the world of NQP. NQP is the sub-language that forms the building blocks of the Perl 6 language. It's more difficult to write, but you'll find that most expensive operations in the Perl 6 core are written in NQP (including the existing permutations and combinations built-ins).

Writing these algorithms in NQP was a challenge for me. I hadn't written NQP before, so I mainly copied what I'd seen in the Rakudo code base, and referred to the list of NQP Opcodes page when necessary. The reward for my efforts was functions that ran much faster. I converted the few different algorithms I found to NQP, but the the above one was also (marginally) the fastest in NQP.

This post is already quite long enough, so I don't want to dump a whole page of NQP code here, but while my mind still has a hankering for combinatorics, I figure I might tackle a few more algorithms and make a module out of it. I'm gonna keep it off the ecosystem until it's a bit more fleshed out, but if you're interested in combinatorics, and/or a deft hand with NQP, pull requests are welcome.

Lastly, I would be remiss to mention that Perl 5 has a Algorithm::Combinatorics module, which has just about any combinatoric algorithm you could need written in fast XS, and it can be used just fine in Perl 6 via Inline::Perl5.

> use Algorithm::Combinatorics:from<Perl5> 'combinations_with_repetition'
> combinations_with_repetition(<A B C D>, 2)
[[A A] [A B] [A C] [A D] [B B] [B C] [B D] [C C] [C D] [D D]]

Once imported, it's combinations_with_repetition function is at least twice as fast as my NQP algorithm. Which is to say, if you have a C compiler installed, and have Perl 5 built with the right flags to support Inline::Perl5, you can install that module and use it today.

For the rest of you who need/want a fast native combinatorics library, I hope to implement as many of those algorithms as I can in NQP to make a Perl 6 equivalent of Algorithm::Combinatorics. NQP still won't top C for performance, but Perl 6 will allow very nice functionality, such as lazy evaluation, and Iterator shortcuts like count-only (which I've already implemented).

use Combinatorics :multicombinations;
use Algorithm::Combinatorics:from<Perl5> 'combinations_with_repetition';

sub time-it($desc, &func) {
    say "$desc: {func()} (%s seconds)".sprintf: now - ENTER now;
}

time-it 'Perl 6', { multicombinations(^16, 10).elems }
time-it 'Perl 5', { combinations_with_repetition(^16, 10).elems }

#`[ OUTPUT:
Perl 6: 3268760 (0.0043160 seconds)
Perl 5: 3268760 (5.1210621 seconds)
]

For algorithms that can find the "nth" iteration, then the skip methods can also be implemented for fast indexing into the sequence.

I'm not sure about some of the names, though. For example, combinations-with-replacement is quite a mouthful. I've seen it referred to as multicombinations in some circles - so that's what I'm using - but I'm not entirely sure if it means the same thing. If you're familiar with combinatorics, let me know if that name makes sense.

I've purposely labeled this article "Part 1" to force gently remind myself to keep working on this stuff. I'll probably be tackling some permutation of the permutations algorithm next.

To be continued...

Everyone Loves Porgs

2018-02-17 08:35, Tags: perl roles

It's been a while. I have several post ideas in various stages of completion, and it's hard to prioritise that over life sometimes... So I figure I need to start posting shorter ideas and things I've been playing with, lest this turn into one of those blogs that never updates. So here we go.

Classes are really easy to define in Perl 6. They're so easy that I find myself using them to encapsulate small Hash-like things, where I also want maybe one or two methods

class Contact {
    has $.name;
    has $.phone;
    has $.bday;
    method age {
        (Date.new($.bday), *.later(:1year) ...^ * > Date.today).end
    }
}

Yes, that's an inefficient way to calculate age... Like a lot of things in life, that method gets slower the older you are.

Anyways, now I have defined a simple little class for holding some data together, but to actually instantiate one I have to bust out some named arguments.

my @contacts;
@contacts.push: Contact.new(:name<John>, :phone<555-1111>, :bday<1940-10-09>);

Who's got time for all those characters? Sometimes I just want to build them with positional args, but that means writing a custom multi method new to handle those cases... but I'm just throwing together a quick & dirty class, is it really worth my time to build a custom constructor?

So I started playing around, and created a Role which lets me build my class with Positional arguments... or an Array.. or List... and hey, I threw in a Hash for free!

@contacts.push: Contact.new('James', '555-1112', '1942-06-18');

@contacts.push: Contact.new(< George 555-1113 1943-02-25 >)

my %hash = name => 'Richard', phone => '555-1114', bday => '1940-07-07';
@contacts.push: Contact.new(%hash);

I used the introspection method .^attributes to get a list of attributes. I'm only interested in local attributes (not inherited ones), though you certainly could change that, or even control it via a Parametrized Role. I'm also only interested in attributes that have an accessor (ie. public attributes).

role Porgs {
    multi method new(*@args where *.elems) {
        self.bless: |%(
            self.^attributes(:local)
                .grep(*.has_accessor)
                .map(*.name.substr: 2)
            Z=> @args)
    }
    multi method new(List $args) {
        self.new: |$args
    }
    multi method new(%args) {
        self.bless: |%args
    }
}

class Contact does Porgs { ... }

I called the role Porgs, which is a contraction of "Positional Args", but also shares the name of a creature from Star Wars. The Porgs role allows you to write classes which are small and cute, much like the creature. Also, everyone loves Porgs.

So that's all for today. I 'm not planning on publishing this to the ecosystem or anything, so feel free to steel this idea, improve upon it, rename it and publish it yourself to the ecosystem if you so desire. Also, I'm not sure if the fact that self.^attributes returns the attributes in the order you declare them is an is an implementation detail... so perhaps that might change?

It's A Wrap

2017-11-27 13:43, Tags: perl python functional

In my last post, I briefly touched on the concept of wrapping functions. I also learned that they are similar to decorators in Python. Apart from one time I used the @property decorator in a Python class to make some attributes read-only, I didn't really know what they were. I just figured it was some weird Python syntax. I've since learned a little be more and played around with them in Python and both Perls.

A decorator is a function that takes another function as it's argument, and typically does something "around" that function, which is why it's also referred to "wrapping" a function. A decorator can't change what the wrapped function does internally, but it can can run code before or after calling that function, or not call it at all.

I may use the words 'wrapper' and 'decorator' interchangeably, by which I mean 'a function that wraps another function'

There are some quintessential applications for decorators; the main ones being caching, logging, and timing of functions. As a reference point, here is a timing decorator in Python 3.6.

import time

def timed(func):
    name = func.__name__
    def wrapped(*args):
        start = time.time()
        res = func(*args)
        print(f"Run time for function '{name}' was {time.time() - start:f}")
        return res
    return wrapped

@timed
def costly(n):
    time.sleep(n);
    return 'Have a string'

x = costly(3)
# OUTPUT: Run time for function 'costly' was 3.02231

print(x)
# OUTPUT: Have a string

In the above example, I grab the name of the function, then create the wrapper function. My wrapper kicks off a timer, then runs the original (decorated) function and assigns the result to a variable res. I then stop the time, print out the stats then return the result.

So without further ado, or much explanation, here's a Perl 6 sub trait that achieves the same result.

multi sub trait_mod:<is>(Routine $func, :$timed) {
    $func.wrap({
        my $start = now;
        my $res = callsame;
        note "Run time for function '{$func.name}' was {now - $start}";
        $res;
    })
}

sub costly($n) is timed {
    sleep($n);
    return 'Have a string';
}

my $x = costly(3);
# OUTPUT: Run time for function 'costly' was 3.0030732

say $x;
# OUTPUT: Have a string

Most of this should be fairly obvious, except maybe callsame, which I covered in my last post... but if you need a refresher, it tells the dispatcher to call the same function that was just called. Also, note the note function, which is exactly like say except that it outputs to STDERR.

Traits wrap a function at (some time around) compile time, but sometimes you might want to wrap a function at runtime, or rather... You might want to decide whether you want to wrap a function at runtime; which functions you want wrapped with what; and when.

Take debugging for example. It would be trivial to create a trait that reports to STDERR when a function has been called, and with what arguments... but adding and removing a trait everytime you want to debug - especially on multiple functions - can get a little unwieldy.

Typically when you debug with print statements (we all do it!) you might manage your programs DEBUG mode via a global variable. At runtime you can inspect the variable and wrap your desired functions accordingly.

constant DEBUG = True;

sub foo($n) {
    return $n × $n;
}

&foo.wrap(&debug) if DEBUG;

my $x = foo(42);

sub debug(|c) {
    my &func = nextcallee;
    my $res = func(|c);
    note "Calling '{&func.name}' with args {c.perl} returned: {$res.perl}";
    $res;
}

# STDERR: Calling 'foo' with args \(42) returned: 1764

The .wrap() method actually returns something called a WrapHandle, which is handy if you want to be able to unwrap your function at any point. It also means you can decide which wrappers get removed.

Perhaps you have a logging wrapper, something that performs a similar role as the debug wrapper, but instead punts the information to your logger of choice, or maybe just a text file. You want to disable the debugger at some point, but keep logging.

my $wh-logger = &foo.wrap(&logger);

my $wh-debug = &foo.wrap(&debug) if DEBUG;

my $x = foo(42);

# Success threshold, debugging is no longer required
&foo.unwrap($wh-debug) if DEBUG;

# Calls to 'foo' still hit the logger
my $y = foo(19);

The beauty of wrappers is your wrapped functions don't have to know they are being wrapped. They can concern themselves with their core purpose. Additionally they only need to be wrapped once, instead of, for example, manually calling your logger function all over the place.

So these decorator things are nice, but I still use Perl 5 quite a lot, and I wanted to know if there was a way to wrap functions in Perl 5 with the same syntactic niceness that trait's provide. What I eventually landed on was attributes, and Attribute::Handlers.

Like trait mods (and Python decorators), attributes are added at the point of your function declarations. Attribute::Handles just makes working with them a little easier. Here's the example from up top, implemented with Perl 5.

use v5.26;
use warnings; no warnings 'redefine';
use experimental 'signatures';
use Time::HR 'gethrtime';
use Attribute::Handlers;

sub Timed( $pkg, $sym, $code, @ ) :ATTR {
    my $func = substr( ${$sym}, length($pkg) + 3 );
    *$sym = sub (@args) {
        my $start = gethrtime();
        my $res   = $code->(@args);
        my $time  = ( gethrtime() - $start ) / 1_000_000_000;
        say {*STDERR} "Run time for function '$func' was $time";
        return $res;
    }
}

sub costly($n) :Timed {
    sleep($n);
    return 'Have a string';
}

my $x = costly(3);
# STDERR: Run time for function 'costly' was 3.001124

say $x;
# OUTPUT: Have a string

A few caveats to note about Perl 5... This is classed as redefining a symbol that already exists, and Perl will give a warning that the wrapped function has been redefined, so I disabled that warning. It will also give a warning if you give your attribute an all-lowercase name, as lowercase attributes are reserved for possible future use. Also, as far as I found, the only way to import attributes from a module is to declare them into the UNIVERSAL namespace, for example: UNIVERSAL::Timed, which technically means you don't even need to export them from your module, so... Yay, I guess.

One final note. It's curious to me that I'm talking about "wrapping" and "decorating" this close to December, when those words typically mean something else entirely. Happy holidays!

Reddit comments

Perl 6 on Rails

2017-06-16 15:33, Tags: perl functional

I saw this interesting article titled Railway Oriented Programming by Scott Wlaschin. Initially I just clicked through the slides and the gist, as I understand it, is to define "chainable" functions that also encapsulate error handling. I later watched the video of the talk and highly recommend it. It's interesting and engaging, and Scott has a good sense of humour.

Ultimately it's about allowing you to write your programs focusing on the "happy path", ie. the code path when everything goes right. We often think about our code along the happy path. Unfortunately, you then have to add additional code for handling errors, typically by throwing if/else or try/catch blocks everywhere and making your code ugly in the process. An alternate error handling methodology is a concept he refers to as "two-track functions".

These functions can accepts 2 different types of input, and return 2 different types of output... like a railway station with two tracks, ya see! In the example, these types indicate either Success or Failure, and if several of your functions can accept and return both, you can chain them together easily. The talk actually covers some oft' confusing functional concepts like "monads" (scary quotes!) in an approachable way. Just go and watch the talk.

The language used is F#, which is billed as a functional language. Now, I'm no functional programmer. My vocabulary extends primarily to the so-called "scripting" languages: Perl, Python, Powershell, Bash... but Perl 6 is kind of a distant relative of another functional language, Haskell. One of the initial Perl 6 compilers (called Pugs) was implemented in Haskell.

Although Pugs is no longer actively developed, it was an important step in the path towards Rakudo, which is currently the most developed Perl 6 compiler. Pugs helped solidify a lot of the ideas in Perl 6, and as the language was being implemented by people familiar with Haskell, there was a cross-pollination of some functional ideas from Haskell to Perl 6... but enough with the history lesson. I decided to see how I could implement something similar in Perl 6, just for a bit of fun.

I don't want to build and entire app here that receives input from a browser, validates an email address, updates a database, etc. I'm just going to do the first thing - validate an email - and I'm going to define some very banal checks on my email validator to make the code simple. Email addresses must contain an @, must be in lowercase, and mustn't be a .io... because I said so! This is not an effective way to validate an email address.

I start by defining my validator functions, which look like this.

sub contains-at( Str $s ) {
    when not $s.contains('@') {
        fail("Address is missing '@' symbol")
    }
    default { $s }
}

sub is-lower( Str $s ) {
    when $s ne $s.lc {
        fail("Address is not lower-case")
    }
    default { $s }
}

sub not-io( Str $s ) {
    when not $s.ends-with('.io') {
        fail("I don't like '.io' domains")
    }
    default { $s }
}

For the conditional check inside my validators I'm using a when block, which comes from the given/when/default construct, Perl's friendlier sounding version of switch/case. I've used this in place of if/else because when automatically short-circuits. It doesn't really matter in this check for which there is only 2 branches... but if I later decide to throw in additional checks, I can just add more when blocks.

In isolation, these functions are fine. If I pass an email address to each one, it will perform a validation check and if it passes the check, the address is returned. That means if I input a "valid" email address, I could chain them together and it would pass through each validator. This is the happy path... but if one of the validations fails, it will pass a Failure object to the next function which is expecting a Str and die. These functions all have one-track input, but two-track output. Here's a slide from the talk.

So how to we convert it to two-track input? Scott - staying true to his train track analogy - builds a kind of adaptor block. He does this with a "bind" operation, which binds an additional function to his validators. As the slide above implies, this adapter block handles a possible Failure input, turning it into a true two-track function, which can compose (chain) nicely with other two-track functions... but can I achieve this in Perl 6? I think so?

I reiterate that I'm barely knowledgeable on functional programming concepts, so I could be wrong here, but it seems that this concept of "bind" is similar to "wrap" in Perl 6. wrap is method on a Routine (aka, a function) that allows you to execute additional code around a function call. The docs tell me this is similar to Decorators in Python, if that helps. I can use a wrapper function to check for Failure (and return if so) before doing my stringy checks.

sub adapter( $input ) {
    when $input ~~ Failure { $input }
    default { callsame() }
}

I can now wrap this "adaptor block" function around my validators. If the adapter receives a failure, it simply returns it. Otherwise, callsame() will call the function that it's wrapped around. To wrap my functions, I'll create a Trait which simplifies applying it to my validator functions. I'm calling my trait "validator" but you could name it anything.

sub trait_mod:<is>(Routine $r, :$validator) {
    $r.wrap(&adapter)
}

Alternatively, I can do this all in one step by defining the adaptor function anonymously inside the trait definition.

sub trait_mod:<is>(Routine $r, :$validator) {
    $r.wrap(-> $input {
        when $input ~~ Failure { $input }
        default { callsame() }
    })
}

Once the trait is defined all I need to do to wrap my functions is add two words, is validator, to the function definition.

sub contains-at(Str $s) is validator {
    when not $s.contains('@') {
        fail("No '@' in email address")
    }
}

I'm almost finished, but there one more thing I want to take care of first. Perl 6 is a dynamic language with gradual typing, so I don't need to define types on all my variables... but imagine you were implementing this sort of code in much larger system, with code spread across multiple files. Once a code base gets large enough, enforcing types everywhere helps maintain correctness, but what type will I get back from validate?

The answer is I might get either a Str or a Failure. In the original article, Scott defines a sum type called Result that can indicate either Success or Failure. Perl 6 can do something similar with Junctions. Typically you might use Junctions to compare a value against multiple values... but it can also apply to type subsets. I won't cover Junctions here. You can refer to the docs, or (Perl 6 core dev) Zoffix has a blog post about them here. Here, I'm just going to define a new subset type that type that has a constraint of any(Str, Failure).

my subset Result where Str|Failure;

This new Result sub-type will be my return value, and it will also be the type signature for my adaptor block... and that's about it! My validators have all been adapted to handle two-track input, I'm ready to chain them together,

sub validate(Str $input) {
    $input
    ==> contains-at()
    ==> is-lower()
    ==> not-io()
}

my Result $res = validate('User@host.org');

say "Validation check completed";

Well, that looks quite Functional with a capital F. This syntax uses the Perl 6 feed operator, that allows functions to be chained together (similar to method chaining) which "feeds" the result of the previous function into the next. So now I'm ready to call my validate() function.

Before I do, though, I quickly want to cover what a Failure actually is. Whereas an Exception throws when it occurs, a Failure does not. You can pass a Failure around - or assign it to a variable - but if you try to evaluate it, it will be promoted to an Exception and dump a traceback to where it came from. This allows errors to be handled using standard error handling instead of try/catch.

Due to how a Failure works , I should always get the Validation check completed message regardless of success or failure. Note that my address has a capital letter, so if I simply tried to say $res, the Failure would be promoted to a full-blown Exception and throw... but the whole point of using a Failure is so I can handle it with simple error checking, thus avoiding an ugly traceback.

given $res {
    when Failure { say "FAILURE: $res.exception()" }
    default      { say "SUCCESS: $res"             }
}

I ran it (with the purposely "invalid" address) and go my desired output.

Validation check completed
FAILURE: Email address is not lower-case

Groovy! I changed my input and tested all the fail conditions and the "happy path" and it all worked as I hoped, so I'd call this a success, but there one more thing that bothering me: I have an identical default block duplicated in each validator. I decided to push my adaptor further and get it to handle the default return as well. There might be a better way to do it, but in typical /me fashion, I came up with something that worked and left it that way. Full code incoming.

my subset Result where Str|Failure;

sub trait_mod:<is>(Routine $r, :$validator) {
    $r.wrap(sub (Result $input) {
        when $input ~~ Failure { $input }
        default {
            my $result = callsame();
            when $result ~~ Failure { $result }
            default { $input }
        }
    })
}

sub contains-at(Str $s) is validator {
    when not $s.contains('@') {
        fail("No '@' in email address")
    }
}

sub is-lower(Str $s) is validator {
    when $s ne $s.lc {
        fail("Email address is not lower-case")
    }
}

sub not-io(Str $s) is validator {
    when $s.ends-with('.io') {
        fail("I don't like '.io' domains")
    }
}

sub validate(Str $input) {
    $input
    ==> contains-at()
    ==> is-lower()
    ==> not-io()
}

my Result $res = validate('User@host.org');

say "Validation check completed";

given $res {
    when Failure { say "FAILURE: $res.exception()" }
    default      { say "SUCCESS: $res"             }
}

Forget about the trait, check out my validator functions! Talk about your single responsibility principle. Each one now just has a single when block, and the trait is handling the potential "else" clause. Obviously I could have thrown all of these checks inside a single given block, disable fallthrough with proceed and be done with it... but that's not the point! Remember this is a very simplified model of this concept of two-track functions.

"so... like, a model train set?"

Quiet you! So there you have it. I'm sure smarter people than I can think of ways to improve and extend these ideas, but for me at least, it has been fun using Perl 6 to explore some interesting functional concepts. I can certainly see some benefits to handling error checking this way, particularly if you have a large system that runs various validation checks on data as it passes though your pipeline.

Finally, Scott also advocates for defining your errors in an Enum and then stringifying them later. He makes a good case for this - and it's trivial to do - but I won't do it here, this post is too long already. It's not strictly a functional idea, but a good idea none-the-less. Think of it as your homework assignment.

Later Earlier