Skip to content

Instantly share code, notes, and snippets.

@daotoad
Last active December 16, 2018 10:52
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save daotoad/47bcbc6f1dc066fff982a72481c6bcd2 to your computer and use it in GitHub Desktop.
Save daotoad/47bcbc6f1dc066fff982a72481c6bcd2 to your computer and use it in GitHub Desktop.
Getting to Know Perl6 From the Command Line: An Article for the 2018 Perl6 Advent Calendar
1234,Bobby Smith
1235,Rosa Felix
1236,Ramesh Patil
1245,Virginia Ryder
1356,Snively Witherspoon
1358,Burnedette Down
1366,Evelyn Tent
1356,Snively Witherspoon
1358,Burnedette Down
1366,Evelyn Tent
1234,Bobby Smith
1235,Rosa Felix
1236,Ramesh Patil
1245,Virginia Ryder
123, Serge Powers
#!/usr/bin/env perl6
use v6.d;
=NAME nicelist
=VERSION 1.0
=para
This script provides utilities for managing Santa's Naughty and Nice Lists.
my %*SUB-MAIN-OPTS =
:named-anywhere, # allow named variables at any location
;
=head1 Data Types
#| Path to a child data list.
subset FilePath of Str:D where *.IO.f();
#| Broken path, used for error reporting.
subset FileNotFound of Str:D where !*.IO.f();
#| Commands that need the Naughty List. Used for error reporting.
subset NaughtyListCommand of Str:D where * eq 'audit'|'build';
#| Commands that need the list of all kids. Used for error reporting.
subset AllKidsCommand of Str:D where * eq 'audit'|'build';
#| Commands that need the Nice List. Used for error reporting.
subset NiceListCommand of Str:D where * eq 'audit';
#| Child class used to support set operations on Naughty and Nice lists.
class Child {
has Str $.id is readonly;
has Str $.name is readonly;
multi method WHICH (Child:D:){ "{self.WHAT.^name}|{$.id}-$.name}" }
}
=head1 MAIN Functions
#| Catch invocations where the list of all children path is invalid
multi sub MAIN (
AllKidsCommand $cmd,
FileNotFound :$all,
*%stuff
) is hidden-from-USAGE {
die "List of all children file does not exist";
}
#| Catch invocations where the Naughty List path is invalid
multi sub MAIN (
NaughtyListCommand $cmd,
FileNotFound :$naughty,
*%stuff
) is hidden-from-USAGE {
die "Naughty List file does not exist";
}
#| Catch invocations where the Nice List path is invalid
multi sub MAIN (
NiceListCommand,
FileNotFound :$nice,
*%stuff
) is hidden-from-USAGE {
die "Nice List file does not exist";
}
#| Rebuild the Nice List
multi sub MAIN (
'build',
FilePath :$all, #= path to file containing the list of all children
FilePath :$naughty #= path to file containing the Naughty List
) {
my Set $naughty-children = set load-child-list( $naughty );
my Set $all-children = set load-child-list( $all );
unless ( $naughty-children (<=) $all-children ) {
say "Error! Naughty list contains children not in all-children list.";
return False;
}
my $nice-children = $all-children (-) $naughty-children;
print-report( $nice-children, :header );
}
#| Compare all the lists for correctness
multi sub MAIN (
'audit',
FilePath :$all, #= path to file containing the list of all children
FilePath :$naughty, #= path to file containing the Naughty List
FilePath :$nice, #= path to file containing the Nice List
) {
my Set $naughty-children = set load-child-list( $naughty );
my Set $all-children = set load-child-list( $all );
my Set $current-nice-children = set load-child-list( $nice );
my $computed-nice-children = $all-children (-) $naughty-children;
if ( my $unknown = $naughty-children (-) $all-children ) {
say "Unknown children found in Naughty List";
print-report($unknown, :header);
}
if ( $current-nice-children == $computed-nice-children ) {
say "Results match.";
return unless $unknown;
}
if ( my $current = $current-nice-children (-) $computed-nice-children ) {
say "Current Nice List has additional children:";
print-report($current, :header);
}
if ( my $computed = $computed-nice-children (-) $current-nice-children ) {
say "Computed Nice List has additional children";
print-report($computed, :header);
}
}
=head1 Supporting Functions
#| Load Child data from a CSV
sub load-child-list ( Str $path ) {
my $fh = IO::Path.new( $path ).open();
my @children = (
$fh.lines # Read all the lines from the file handle
==> map({ .split(',', 2 ) }) # "Parse" CSV
==> map({ %( <id name> Z=> @$_ ) }) # Make hashes
==> map({ Child.new( |$_ ) }) # To slip into child constructor arguments
);
$fh.close;
return @children;
}
#| Print a report from an array of Child objects
multi sub print-report (
Child @children, #= List of Child objects to print
Bool :$header #= Should we print the optional header?
) {
say "id,name" if $header;
say "{.id},{.name}" for @children;
say '';
}
#| Coerce a Set into an array of Child objects
multi sub print-report ( Set $children, Bool :$header ) {
print-report( Array[Child].new( $children.keys, :$header ) );
}

Checking Your List Twice

Getting to Know Perl6 From the Command Line

This was Sniffles the Elf's big chance! After years of drudgery in the ribbon mines, they'd finally been moved up into the List Management Department. As a shiny new Associate Nice List Auditor, Sniffles was on their way to the big time.

On their first day, when Sniffles arrived, Mr. Grumble--their new boss, was waiting. "Nice List management is deep trouble, our data was accidentally erased when someone spilled milk and cookie crumbs on the server. We'd been so busy checking the list that we forgot to check our backups! And now we have to rebuild everything from scratch! After the sackings, we're a little short handed, so it's up to you to save the day."

Sniffles, being particularly industrious, dove into the problem with relish. After a bit of research they realized that all the data they needed was available, they just needed to collect it.

Their friend in the ribbon mines, a self-professed oral historian named Hermie had been going on about how great Perl6 is. Sniffles decided to give it a try.

Like pulling Teeth?

Sniffles started by tossing out the standard first script in a new language:

use v6.d;

say "Nice List restored!!!";

The script ran and dutifully printed out the message. With just a few days left until Christmas, it was time to get serious and hit the Perl6 documentation.

A little browsing lead Sniffles to the page on the Perl 6 command line interface utilities . They liked the looks of the special MAIN subroutine it describes.

say 'Started initializing nice lister.';
sub MAIN() { say "Nice List restored!!!" }
say 'Finished initializing nice lister.';

Generates:

Started initializing nice lister.
Finished initializing nice lister.
Nice List restored!!!

Well at least that corralled their startup code. Sniffles ditched the initialization messages, they were just noise. But they were sure that this MAIN function had to have some more tricks up it's sleeve to get Hermie so excited.

Back to the docs... Sniffles checked Learn X in Y Minutes Perl6 page. The extra section on MAIN near the end was a gold-mine! Sniffles shuddered at the thought.

"Okay, so if we provide MAIN with a subroutine signature, Perl6 handles the command line parsing for us. Even better, it auto-generates help content," they mumbled to themself.

sub MAIN (
    :$list-of-all-kids,
    :$naughty-list
) { ... }

Generates:

$ nice-list
Usage:
  nicelist [--list-of-all-kids=<Any>] [--naughty-list=<Any>]

And running the script gets:

Stub code executed
  in sub MAIN at foo line 1
  in block <unit> at foo line 1

Nice.

But the switch names are kind of long. Since TheNorthPole.io is a devops shop, Sniffles figured they'd probably have to type them a bunch. Yuck. Shorter names would be fine if you could add some explanatory text. Perl6's support for literate programming using POD6 markup made it easy to add annotation.

#| Rebuild the Nice List
sub MAIN (
    :$all,    #= path to file containing the list of all children
    :$naughty #= path to file containing the Naughty List
) { ... }

Generates:

Usage:
  nicelist [--all=<Any>] [--naughty=<Any>] -- Rebuild the Nice List
  
    --all=<Any>        path to file containing the list of all children
    --naughty=<Any>    path to file containing the Naughty List

Sniffles was impressed, but they knew that argument validation is the other part of writing a CLI that can get tedious. "What has Perl6 done for me lately?" they wondered.

A strong, silent type

Perl6 has a gradual type system with both compile and run-time type checking. Gradual typing allowed Sniffles to ignore type checking so far. They added some types and see what happened.

Sniffles defined a subset of Str with a type smiley that uses whatever code to verify that a file exists at the given path.

subset FilePath of Str:D where *.IO.f;

#| Rebuild the Nice List
sub MAIN (
    FilePath :$all,    #= path to file containing the list of all children
    FilePath :$naughty #= path to file containing the Naughty List
) { ... }

They ran the script:

$nice-list  --naughty=naughty.kids --all=notAFile.bleh
Usage:
  nice-list [--all=<FilePath>] [--naughty=<FilePath>] -- Rebuild the Nice List
  
    --all=<FilePath>        path to file containing the list of all children
    --naughty=<FilePath>    path to file containing the Naughty List

Sniffles ran the script again without arguments and a couple of other invalid ways. Each time it caught the invalid input and automatically displayed the usage message. "Very nice," Sniffles thought, "Thing is, the error reporting still sucks. You get the same result if you leave off an argument as if you pass in a missing file."

Elf-type mismatch - Cobbling up improved error handling

"Ugh! How do I get around this problem?" Sniffles shuffled around the docs some more. Multiple Dispatch and slurpy parameters. They added another subset and a couple of new definitions of MAIN:

subset FileNotFound of Str:D where !*.IO.f();
    
multi sub MAIN (
    FilePath :$all,    #= path to file containing the list of all children
    FilePath :$naughty #= path to file containing the Naughty List
) { ... }
    
multi sub MAIN (
    FileNotFound :$all,
    *%otherStuff
) {
    die "List of all children file does not exist";
}
    
multi sub MAIN (
    FileNotFound :$naughty,
    *%otherStuff
) {
    die "Naughty List file does not exist";
}

They got:

Usage:
  nice-list [--all=<FilePath>] [--naughty=<FilePath>] -- Rebuild the Nice List
  nice-list [--all=<FileNotFound>] [--naughty=<FilePath>]
  nice-list [--all=<FilePath>] [--naughty=<FileNotFound>]
  
    --all=<FilePath>        path to file containing the list of all children
    --naughty=<FilePath>    path to file containing the Naughty List

Which worked perfectly...except now they had error generation entries in the usage! Double yuck. Sniffles returned to the article on CLI interfaces. Adding the right trait to the MAIN subs will make them disapper from auto-generated usage:

multi sub MAIN (
    FileNotFound :$all,
    *%otherStuff
) is hidden-from-USAGE {
    die "List of all children file does not exist";
}

And the mess was gone!

We won't go until we get some!

Mr. Grumble walked up, he paused to peer at Sniffles' screen. "Interesting work there, Sniffles. We need that script and we need it yesterday. Oh, and we need it to be able to audit an existing Nice List as well as rebuild one. We need that too. See ya." He disappeared before Sniffles could blink.

Okay, working on a creeping feature is better than being forced to eat figgy pudding, Sniffles thought. They added those commands:

#| Rebuild the Nice List
multi sub MAIN (
    'build',
    FilePath :$all,    #= path to file containing the list of all children
    FilePath :$naughty #= path to file containing the Naughty List
) { ... }
    
#| Compare all the lists for correctness
multi sub MAIN (
    'audit',
    FilePath :$all,     #= path to file containing the list of all children
    FilePath :$naughty, #= path to file containing the Naughty List
    FilePath :$nice,    #= path to file containing the Nice List
) { ... }

"Great," they thought, "but you have to run the script like nicelist --all=foo --naughty=bar build. Horrible."

my %*SUB-MAIN-OPTS =
    :named-anywhere,    # allow named variables at any location 
;

"It was fixed!" Sniffles did a little dance in their seat.

Usage:
  nicelist build [--all=<FilePath>] [--naughty=<FilePath>] -- Rebuild the Nice List
  nicelist audit [--all=<FilePath>] [--naughty=<FilePath>] [--nice=<FilePath>] -- Compare all the lists for correctness
  
    --all=<FilePath>        path to file containing the list of all children
    --naughty=<FilePath>    path to file containing the Naughty List
    --nice=<FilePath>       path to file containing the Nice List

The runner hits the road.

Okay, now Sniffles had the perfect framework for a great utility script. It was time to actually write the actual thing. Sniffles knew that they were really going to sleigh this project.

In no time flat, Snuffles found that Perl6's feature set helped them whip up a powerful, correct script. They made a Child class, defined identity operations on it, wrote a cheesey CSV parser to load list data, and a reporting function. The built in Set data type provided operators that made it easy to look for entries that were out of place and even easier to rebuild the Nice List.

As soon as they were done, they recovered the Nice List and sent a departmental email to Mr. Grumbles and the rest of their team, proclaiming their success. When Mr. Grumbles saw how nice the script was, with it's usage and error checking, for once, he didn't live up to their name.

In recognition of their hard work and resourcefulness, Sniffles was asked to cut the ribbon at the opening of Santa's newest workshop.

@b2gills
Copy link

b2gills commented Dec 11, 2018

Note that you have is hidden-from-USAGE too early. You used it before explaining it.

Also a where constraint is a type of smartmatch, meaning you can use $_.
So *.IO.f() could be written as just .IO.f().
(Note that it works because it returns a Bool, if it didn't it would return the value to smartmatch against)

And a smartmatching construct can take a literal to match against, so * eq 'audit'|'build' could be written as just 'audit'|'build'.
(Note that I think it would be the same as * eqv 'audit'|'build', but that shouldn't matter.)

@daotoad
Copy link
Author

daotoad commented Dec 11, 2018

To do items:

  • DONE Move final full script to a separate file and link.
  • DONE Tag code with ```perl6 to fix highlighting
  • DONE Fix hidden-from-USAGE
  • DONE decide how to handle where constraints. I'm leaning towards keeping them as is because that's how most of the examples I have seen work. But smartmatch-iness of the where is interesting and important. leaving well enough alone.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment