Day 21 – A Red Secret Santa

The year is ending and we have a lot to celebrate! What is a better way to celebrate the end of the year than with our family and friends? To help achieve that, here at my home, we decided to run a Secret Santa Game! So, my goal is to write a Secret Santa Program! That’s something where I can use this wonderful project called Red.

Red is an ORM (Object Relational Model) for perl6 still under development and not published as a module yet. But it’s growing and it is close to a release.

So let’s create our first table: a table that will store the people participating in our Secret Santa. To the code:

use Red;
model Person {
has UInt $.id is serial;
has Str $.name is column;
has Str $.email is column{ :nullable };
}
my $*RED-DB = database "SQLite";
Person.^create-table;
Person.^create: :name<Fernando>, :email<fco@aco.com>;
Person.^create: :name<Aline>, :email<aja@aco.com>;
Person.^create: :name<Fernanda>;
Person.^create: :name<Sophia>;
.say for Person.^all.grep(*.email.defined).map: *.name;
view raw 1.p6 hosted with ❤ by GitHub

Red maps relational databases to OOP. Each table is mapped to a Red class (model), each of whose objects represents a row.

The way we a create a model is by using the model special word. A model is just a normal class that extends Red::Model and has a MetamodelX::Red::Model‘s object as its metaclassRed does not add any methods you didn’t explicitly create to its models. So to interact with the database you should use the metaclass.

But let’s continue.

The code creates a new model called Person. The name of the table this model represents will be the same name as the model: “Person”. If necessary, you can change the name of the table with the is table<...> trait (for example: model Person is table<another_name> {...}).

This model has 3 attributes:

  • $.name have  an is column trait;
  • $.email have an is column{ :nullable };
  • and $.id has an is serial. That means the same as is column{ :id, :auto-increment }.

Red uses not null columns by default, so if you want to create a nullable columns you should use is column{ :nullable }.

So all attributes on Person are columns. The is serial (I mean the :id part) means that it’s the table’s primary key.

After that it’s setting a dynamic variable ($*RED-DB) for the result of database "SQLite". The database sub receives the driver‘s name and the parameters it expects.

In this case it uses the SQLite driver and if you don’t pass any argument, it will use it as an in memory database. If you want to use a file named secret-santa.db as the database file, you can do database "SQLite", :database<secret-santa.db>. Or, if you want to use a local Postgres, just use  database "Pg"Red uses the variable $*RED-DB to know what database to use.

OK, now lets create the table! As I said before, Red did not add any methods you didn’t explicitly ask for. So, to create the table a metaclassmethod is used. Person.^create-table is how you create the table.

This will run:

CREATE TABLE person(
id integer NOT NULL primary key AUTOINCREMENT,
name varchar(255) NOT NULL,
email varchar(255) NULL
)
view raw 1.sql hosted with ❤ by GitHub

Now we should insert some data. We do that with another meta method (.^create). The .^create meta method expects the same arguments .new expects. Each named argument will set an attribute with the same name. .^create will create a new Person object, save it in the database (with .^save: :insert), and return it.

It runs:

INSERT INTO person(
email,
name
) VALUES(
'fco@aco.com',
'Fernando'
)
view raw 1-1.sql hosted with ❤ by GitHub

Every model has a ResultSeq. That is a sequence that represents every row on the table. We can get its ResultSeq with .^all (or .^rs). ResultSeq has some methods to help you to get information from the table, for example: .grep will filter the rows (as it does in a normal Seq) but it doesn’t do that in memory, it returns a new ResultSeq with that filter set. When its iterator is retrieved, it runs a SQL query using everything set on the ResultSeq.

In our example, Person.^all.grep(*.email.defined).map: *.name will run a query like:

SELECT
person.name
FROM
person
WHERE
email IS NOT NULL
view raw 1-2.sql hosted with ❤ by GitHub

And it’ll print:

Fernando
Aline

Okay, we have a code that can save who is entered in our Secret Santa game. But each one on it want different gifts. How can we know the wishes of each one?

Let’s modify the code to make it save the wishlist for everyone participating in the secret santa:

use Red;
model Person { }
model Wishlist {
has UInt $!id is serial;
has UInt $!wisher-id is referencing{ Person.id };
has Person $.wisher is relationship{ .wisher-id };
has Str:D $.name is column is required;
has Str $.link is column;
}
model Person is rw {
has UInt $.id is serial;
has Str $.name is column;
has Str $.email is column;
has Wishlist @.wishes is relationship{ .wisher-id }
}
my $*RED-DB = database "SQLite";
Wishlist.^create-table;
Person.^create-table;
my \fernando = Person.^create: :name<Fernando>, :email<fco@aco.com>;
fernando.wishes.create: :name<Comma>, :link<https://commaide.com>;
fernando.wishes.create: :name("perl6 books"), :link<https://perl6book.com>;
fernando.wishes.create: :name("mac book pro"), :link<https://www.apple.com/shop/buy-mac/macbook-pro/15-inch-space-gray-2.6ghz-6-core-512gb#>;
my \aline = Person.^create: :name<Aline>, :email<aja@aco.com>;
aline.wishes.create: :name("a new closet"), :link<https://i.pinimg.com/474x/02/05/93/020593b34c205792a6a7fd7191333fc6–wardrobe-behind-bed-false-wall-wardrobe.jpg>;
my \fernanda = Person.^create: :name<Fernanda>, :email<faco@aco.com>;
fernanda.wishes.create: :name("mimikyu plush"), :link<https://www.pokemoncenter.com/mimikyu-poké-plush-%28standard-size%29—10-701-02831>;
fernanda.wishes.create: :name("camelia plush"), :link<https://farm9.static.flickr.com/8432/28947786492_80056225f3_b.jpg>;
my \sophia = Person.^create: :name<Sophia>, :email<saco@aco.com>;
sophia.wishes.create: :name("baby alive"), :link<https://www.target.com/p/baby-alive-face-paint-fairy-brunette/-/A-51304817>;
say "\n{ .name }\n{ .wishes.map({" { .name } => { .link }" }).join("\n").indent: 3 }" for Person.^all
view raw 2.p6 hosted with ❤ by GitHub

That prints:

Fernando
    Comma => https://commaide.com
    perl6 books => https://perl6book.com
    mac book pro => https://www.apple.com/shop/buy-mac/macbook-pro/15-inch-space-gray-2.6ghz-6-core-512gb#

Aline
    a new closet => https://i.pinimg.com/474x/02/05/93/020593b34c205792a6a7fd7191333fc6--wardrobe-behind-bed-false-wall-wardrobe.jpg

Fernanda
    mimikyu plush => https://www.pokemoncenter.com/mimikyu-poké-plush-%28standard-size%29---10-701-02831
    camelia plush => https://farm9.static.flickr.com/8432/28947786492_80056225f3_b.jpg

Sophia
    baby alive => https://www.target.com/p/baby-alive-face-paint-fairy-brunette/-/A-51304817

Now we have a new model Wishlist that refers to a table named wishlist. It has $!id as id$!name and $!link are columns, and there are some things new! has UInt $!wisher-id is referencing{ Person.id }; is the same as has UInt $!wisher-id is column{ :references{ Person.id } }; that means it’s a column that’s a foreign key that references the id Person‘s column. It also has a has Person $.wisher is relationship{ .wisher-id }; it’s not a column, it’s a “virtual” field. the $ sigil means that there is only 1 wisher for a wish. And is relationship expects a Callable that will receive a model. If it’s Scalar it will receive the current model as the only argument. So, in this case, it will be Wishlist. The return of the relationsip’s Callable must be a column that references some other column.

Lets see how this table is created:

CREATE TABLE wishlist(
id integer NOT NULL primary key,
name varchar(255) NOT NULL,
link varchar(255) NULL,
wisher_id integer NULL references person(id)
)
view raw 2.sql hosted with ❤ by GitHub

As you can see, no wisher column is created.

The Person model has changed too! Now it has a @.wishes relationship (has Wishlist @.wishes is relationship{ .wisher-id }). It uses a @ sigil so each Person can have more than one wish. The Callable passed will receive the type of the Positional attribute (Wishlist on this case) and must return a column that references some other column.

The table created is the same as before.

We created a new Person as we did before: my \fernando = Person.^create: :name<Fernando>, :email<fco@aco.com>; and now we can use the relationship (wishes) to create a new wish (fernando.wishes.create: :name<Comma>, :link<https://commaide.com>). That creates a new wish for Fernando running the following SQL:

INSERT INTO wishlist(
name,
link,
wisher_id
) VALUES(
'Comma',
'https://commaide.com',
1
)
view raw 2-1.sql hosted with ❤ by GitHub

Had you seen? wisher_id is 1… 1 is Fernando’s id. Once you have created the wish from Fernando’s .wishes(), it already knows that it belongs to Fernando.

And then we define wishes for every person we create.

Then we loop over every Person in the database (Person.^all) and print its name and loop over that person’s wishes and print its name and link.

Okey, we can save who is participating… get what they want… but the draw? Who should I give a gift to? To do that we change our program again:

use lib <lib>;
use Red;
model Person { }
model Wishlist {
has UInt $!id is id;
has UInt $!wisher-id is referencing{ Person.id };
has Person $.wisher is relationship{ .wisher-id };
has Str:D $.name is column is required;
has Str $.link is column;
}
model Person is rw {
has UInt $.id is id;
has Str $.name is column;
has Str $.email is column;
has UInt $!pair-id is referencing{ ::?CLASS.^alias.id };
has ::?CLASS $.pair is relationship{ .pair-id };
has Wishlist @.wishes is relationship{ .wisher-id }
method draw(::?CLASS:U:) {
my @people = self.^all.pick: *;
for flat @people.rotor: 2 => -1 -> $p1, $p2 {
$p1.pair = $p2;
$p1.^save;
}
given @people.tail {
.pair = @people.head;
.^save
}
}
}
my $*RED-DB = database "SQLite";
Wishlist.^create-table;
Person.^create-table;
my \fernando = Person.^create: :name<Fernando>, :email<fco@aco.com>;
fernando.wishes.create: :name<Comma>, :link<https://commaide.com>;
fernando.wishes.create: :name("perl6 books"), :link<https://perl6book.com>;
fernando.wishes.create: :name("mac book pro"), :link<https://www.apple.com/shop/buy-mac/macbook-pro/15-inch-space-gray-2.6ghz-6-core-512gb#>;
my \aline = Person.^create: :name<Aline>, :email<aja@aco.com>;
aline.wishes.create: :name("a new closet"), :link<https://i.pinimg.com/474x/02/05/93/020593b34c205792a6a7fd7191333fc6–wardrobe-behind-bed-false-wall-wardrobe.jpg>;
my \fernanda = Person.^create: :name<Fernanda>, :email<faco@aco.com>;
fernanda.wishes.create: :name("mimikyu plush"), :link<https://www.pokemoncenter.com/mimikyu-poké-plush-%28standard-size%29—10-701-02831>;
fernanda.wishes.create: :name("camelia plush"), :link<https://farm9.static.flickr.com/8432/28947786492_80056225f3_b.jpg>;
my \sophia = Person.^create: :name<Sophia>, :email<saco@aco.com>;
sophia.wishes.create: :name("baby alive"), :link<https://www.target.com/p/baby-alive-face-paint-fairy-brunette/-/A-51304817>;
Person.draw;
say "{ .name } -> { .pair.name }\n\tWishlist: { .pair.wishes.map(*.name).join: ", " }" for Person.^all

Now Person has two new attributes ($!pair-id and $.pair) and a new method (draw). $!pair-id is a foreign key that references the field id on the same table (Person) so we have to use an alias (.^alias). The other one is the relationship ($.pair) that uses that foreign key.

The new method (draw) is where the magic happens. It uses the method .pick: * that on a normal Positional would shuffle the list. And it does the same here, with the query:

SELECT
person.email , person.id , person.name , person.pair_id as "pair-id"
FROM
person
ORDER BY
random()
view raw 3.sql hosted with ❤ by GitHub

Once we have the shuffled list, we use .rotor to get two items and go one back, so we save what is the pair of each person giving to the next person, and the last person in the list will give to the first person.

And this is the output of our final code:

Fernando -> Sophia
Wishlist: baby alive
Aline -> Fernanda
Wishlist: mimikyu plush, camelia plush
Fernanda -> Fernando
Wishlist: COMMA, perl6 books, mac book pro
Sophia -> Aline
Wishlist: a new closet

As a bonus, let’s check out the track Red is going to follow. This is a current working code:

use Red;
model Person {
has UInt $.id is id;
has Str $.name is column;
has Str $.email is column{ :nullable };
}
my $*RED-DB = database "SQLite";
Person.^create-table;
Person.^create: :name<Fernando>, :email<fco@aco.com>;
Person.^create: :name<Aline>, :email<aja@aco.com>;
Person.^create: :name<Fernanda>;
Person.^create: :name<Sophia>;
.say for Person.^all.map: { "{ .name }{ " => { .email }" if .email }" };
view raw p-extra.p6 hosted with ❤ by GitHub

And this is the SQL it runs:

SELECT
CASE
WHEN (email == '' OR email IS NULL) THEN name
ELSE name || ' => ' || email
END
as "data"
FROM
person
view raw p-extra.sql hosted with ❤ by GitHub

And prints:

Fernando => fco@aco.com
Aline => aja@aco.com
Fernanda
Sophia

3 thoughts on “Day 21 – A Red Secret Santa

  1. Excellent stuff! I’ve been keeping half an eye on this for a while and what I particularly like is that it “Perl6ish” rather than an awkward port of some other ORM.

    I’m sure you’ll get plenty of help and suggestions when people start using it :-)

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.