/home/rafl

For quite some time perl provided a form of my declarations that includes a type name, like this:

my Str $x = 'foo';

However, that didn't do anything useful, until Vincent Pit came along and wrote the excellent Lexical::Types module, which allows you to extend the semantics of typed lexicals and actually make them do something useful. For that, it simply invokes a callback for every my declaration with a type in the scopes it is loaded. Within that callback you get the variable that is being declared as well as the name of the type used in the declaration.

We also have Moose type constraints and the great MooseX::Types module, that allows us to define our own type libraries and import the type constraints into other modules.

Let's glue those modules together. Consider this code:

use MooseX::Types::Moose qw/Int/;
use Lexical::Types;
my Int $x = 42;

The first problem is that the perl compiler expects a package with the name of the type used in my to exist. If there's no such package compilation will fail.

Creating top-level namespaces for all the types we want to use would obviously suck. Luckily the compiler will also try to look for a function with the name of the type in the current scope. If that exists and is inlineable, it will call that function and use the return value as a package name.

In the above code snippet an Int function already exists. We imported that from MooseX::Types::Moose. Unfortunately it isn't inlineable. Even if it were, compilation would still fail, because it would return a Moose::Meta::TypeConstraint instead of a valid package name.

To fix that, let's rewrite the code to this:

use MooseX::Types::Moose qw/Int/;
use MooseX::Lexical::Types qw/Int/;
my Int $x = 42;

Let's also write a MooseX::Lexical::Types module that replaces existing imported type exports with something that can be inlined and returns an existing package name based on the type constraint's name.

package MooseX::Lexical::Types;

use Class::MOP;
use MooseX::Types::Util qw/has_available_type_export/;
use namespace::autoclean;

sub import {
    my ($class, @args) = @_;
    my $caller = caller();

    my $meta = Class::MOP::class_of($caller) || Class::MOP::Class->initialize($caller);

    for my $type_name (@args) {
        # get the type constraint by introspecting the caller
        my $type_constraint = has_available_type_export($caller, $type_name);

        my $package = 'MooseX::Lexical::Types::TYPE::' . $type_constraint->name;
        Class::MOP::Class->create($package);
        $meta->add_package_symbol('&'.$type_name => sub () { $package });
    }

    Lexical::Types->import; # enable Lexical::Types for the caller
}

1;

With that the example code now compiles. Unfortunately it breaks every other usecase of MooseX::Types. The export will still need to return a Moose::Meta::TypeConstraint at run time so this will continue to work:

has some_attribute => (is => 'ro', isa => Int);

So instead of returning a plain package name from our exported function we will return an object that delegates all method calls to the actual type constraint, but evaluates to our special package name when used as a string:

my $decorator = MooseX::Lexical::Types::TypeDecorator->new($type_constraint);
$meta->add_package_symbol('&'.$type_name => sub () { $decorator });

and:

package MooseX::Lexical::Types::TypeDecorator;
use Moose;
use namespace::autoclean;

# MooseX::Types happens to already have a class that doesn't do much
# more than delegating to a real type constraint!
extends 'MooseX::Types::TypeDecorator';

use overload '""' => sub {
    'MooseX::Lexical::Types::TYPE::' . $_[0]->__type_constraint->name
};

1;

Now we're able to use Int as usual and have Lexical::Types invoke its callback on MooseX::Lexical::Types::TYPE::Int. Within that callback we will need the real type constraint again, but as it is invoked as a class method with no good way to pass in additional arguments, we will need to store the type constraint somewhere. I choose to simply add a method to the type class we create when constructing our export. After that, all we need is to implement our Lexical::Types callback. We will put that in a class all our type classes will inherit from:

Class::MOP::Class->create(
    $package => (
        superclasses => ['MooseX::Lexical::Types::TypedScalar'],
        methods      => {
            get_type_constraint => sub { $type_constraint },
        },
    ),
);

The Lexical::Types callback will now need to tie things together by modifying the declared variable so it will automatically validate values against the type constraint when being assigned to. There are several ways of doing this. Using tie on the declared variable would probable be the easiest thing to do. However, I decided to use Variable::Magic (also written by Vincent Pit - did I mention he's awesome?), because it's mostly invisible at the perl level and also performs rather well (not that it'd matter, given that validation itself is relatively slow):

package MooseX::Lexical::Types::TypedScalar;

use Carp qw/confess/;
use Variable::Magic qw/wizard cast/;
use namespace::autoclean;

my $wiz = wizard
    # store the type constraint in the data attached to the magic
    data => sub { $_[1]->get_type_constraint },
    # when assigning to the variable, fail if we can't validate the
    # new value ($_[0]) against the type constraint ($_[1])
    set  => sub {
        if (defined (my $msg = $_[1]->validate(${ $_[0] }))) {
            confess $msg;
        }
        ();
    };

sub TYPEDSCALAR {
    # cast $wiz on the variable in $_[1]. pass the type package name
    # in $_[0] to the wizard's data construction callback.
    cast $_[1], $wiz, $_[0];
    ();
}

1;

With this, our example code now works. If someone wants to assign, say, 'foo' to the variable declared as my Int $x our magic callback will be invoked, try to validate the value against the type constraint and fail loudly. WIN!

The code for all this is available github and should also be on CPAN shortly.

You might notice warnings about mismatching prototypes. Those are caused by Class::MOP and fixed in the git version of it, so they'll go away with the next release.

There's still a couple of caveats, but please see the documentation for that.