Example of method traits in Moose

HelperThing.pm

package HelperThing;
use strict;
use warnings;
use Moose::Exporter;
use 5.024;
use experimental 'signatures';
use MethodMetaRole;

sub my_method($meta,$name,@args) {
    my $body = pop @args;
    my $method_meta = $meta->method_metaclass->wrap(
        @args,
        body => $body,
        name => $name,
        package_name => $meta->name,
        associated_metaclass => $meta,
    );

    $meta->add_method($name,$method_meta);
}

Moose::Exporter->setup_import_methods(
    with_meta => ['my_method'],
    class_metaroles => {
        method => [ 'MethodMetaRole' ],
    },
);

1;

main.pl

#!/usr/bin/env perl
use strict;
use warnings;
use 5.024;
use experimental 'signatures';
use Data::Printer;
use TheClass;
use OperatesOnClass;

my $obj = TheClass->new();
my $dispatcher = OperatesOnClass::build_dispatcher($obj);

$dispatcher->(special_method => ());
$dispatcher->(special_method_bad => ());

MethodMetaRole.pm

package MethodMetaRole;
use Moose::Role;
use 5.024;
use experimental 'signatures';
use Types::Standard qw(InstanceOf);

has return_type => (
    is => 'ro',
    isa => InstanceOf['Type::Tiny'],
    predicate => 'has_return_type',
);

1;

OperatesOnClass.pm

package OperatesOnClass;
use strict;
use warnings;
use 5.024;
use experimental 'signatures';

sub build_dispatcher($object) {
    my %map;
    for my $method ($object->meta->get_all_methods) {
        my $name = $method->name;
        # I'm not sure why ->DOES doesn't work here
        next unless $method->can('return_type');
        if ($method->has_return_type) {
            my $type = $method->return_type;
            $map{$name} = sub {
                my $ret = $method->execute($object,@_);
                my $err = $type->validate($ret);
                if ($err) {
                    return (undef,$err);
                }
                else {
                    return $ret;
                }
            };
        }
        else {
            $map{$name} = $method->body;
        }
    }

    return sub($name,@args) {
        if (my $method = $map{$name}) {
            my ($result,$err) = $method->(@args);
            say "got error calling $name: $err" if $err;
            return $result;
        }
        else {
            say "no such method $name";
            return;
        }
    }
}

1;

TheClass.pm

package TheClass;
use Moose;
use HelperThing;
use Types::Standard qw(Int);
use 5.024;
use experimental 'signatures';

sub normal_method($self) { 1 }

my_method special_method => (
    return_type => Int,
) => sub($self) { 12 };

my_method special_method_bad => (
    return_type => Int,
) => sub($self) { 'boom' };

1;