I want to be able to have a Moo* class with these characteristics:

• an object's attribute can store a reference to the object itself
• that attribute will be type-constrained using a Type::Tiny type so the reference must be of the right type
• the class must function when it is immutable, and the attribute is "required", i.e. an undefined value is unacceptable and it cannot be updated later

E.g.

package GraphQLType;
use Moo;
use Types::Standard -all;
has [qw(children)] => (
  is => 'rwp',
  isa => ArrayRef[InstanceOf['GraphQLType']],
  required => 1,
);

package main;
my $type;
$type = GraphQLType->new(children => [$type]);

The above presents a chicken-and-egg problem: $type will be undefined and therefore fail the type constraint.

A pattern used in graphql-js is "thunking". In Perl terms:

package GraphQLType;
use Moo;
use Types::Standard -all;
has [qw(children)] => (
  is => 'rwp',
  isa => CodeRef | ArrayRef[InstanceOf['GraphQLType']],
  required => 1,
);

package main;
my $type;
$type = GraphQLType->new(children => sub { [$type] });

While that works for the specific type there, how can I have a parameterised type that implements something like this? Also, it will help even more if this can hook into the "lazy" functionality to minimise the code involved in storing the computed value.

package Thunking;

use Moo;
use Types::Thunking -all;
use Types::Standard -all;

has [qw(children)] => (
  is => 'lazy',
  isa => Thunk[ArrayRef[InstanceOf['GraphQLType']]],
  required => 1,
);

Two issues need to be dealt with here: a parameterised Type::Tiny type constraint for a delayed-computation immutable attribute (DCIA), and an actually-functioning DCIA.

Parameterised type

Since this is Perl, there is more than one way to do this. The heart of making a parameterised type in Type::Tiny is to provide a constraint_generator parameter. The most idiomatic way to do this, using only Type::Tiny components, is:

package Types::Thunking;
use Types::TypeTiny -all;
use Type::Library -base;
use Type::Utils -all;
declare "Thunk", constraint_generator => sub { union [ CodeLike, @_ ] };

That's it! If no parameters are given, it works just like a CodeLike. The libraries can take care of any "inline" code generating.

The reason it can be so short is that the constraint_generator must return either a code-ref, which would probably be a closure that captures the parameters passed to it (see below), or simply a Type::Tiny - in which case the other parameterisability parameters are not needed. Since union (which looks like it's normally intended for producing arguments to a declare) returns a suitably-constructed Type::Tiny::Union, it just drops in perfectly.

A more spelled-out version, not using a union type (and for brevity, using CodeRef not CodeLike:

package Types::Thunking;
use Types::Standard -all;
use Type::Library -base;
use Type::Utils -all;
declare "Thunk",
  constraint_generator => sub {
    my ($param) = @_;
    die "parameter must be a type" if grep !UNIVERSAL::isa($_, 'Type::Tiny'), @_;
    return sub { is_CodeRef($_) or $param->check($_) };
  },
  inline_generator => sub {
    my ($param) = @_;
    die "parameter must be a type" if grep !UNIVERSAL::isa($_, 'Type::Tiny'), @_;
    return sub {
      my ($constraint, $varname) = @_;
      return sprintf(
        'Types::Standard::is_CodeRef(%s) or %s',
        $varname,
        $param->inline_check($varname),
      );
    };
  };

This is the "harness" I used for testing these:

#!/usr/bin/perl
use Thunking;
sub do_test {
  use Data::Dumper; local $Data::Dumper::Terse = 1; local $Data::Dumper::Indent = 0;
  my ($args, $should_work) = @_;
  my $l = eval { Thunking->new(@$args) };
  if (!$l) {
    say "correctly did not work" and return if !$should_work;
    say "INcorrectly did not work" and return if $should_work;
  }
  my $val = eval { $l->attr };
  if (!$val) {
    say "correctly did not work" and return if !$should_work;
    say "INcorrectly did not work" and return if $should_work;
  }
  say(($should_work ? "" : "INcorrectly worked: "), Dumper $val);
}
do_test [attr => { k => "wrong type" }], 0;
do_test [attr => ["real value at init"]], 1;
do_test [attr => sub { [ "delayed" ] }], 1;
do_test [attr => sub { { k => "delayed wrong type" } }], 0;

Delayed-computation immutable attribute

In order to make this immutable, we want setting the attribute to fail unless it's us doing it. When reading the attribute, we want to see whether there is computation to be done; if yes, do it; then return the value.

Naive approach

package Thunking;
use Moo;
use Types::Standard -all;
use Types::Thunking -all;
has attr  => (
  is => 'rwp',
  isa => Thunk[ArrayRef],
  required => 1,
);
before 'attr' => sub {
  my $self = shift;
  return if @_; # attempt at setting, hand to auto
  my $value = $self->{attr};
  return if ref($value) ne 'CODE'; # attempt at reading and already resolved
  $self->_set_attr($value->());
}

The before should be fairly self-explanatory but you will see it manually looks in the object's hash-ref, which is usually a clue that your programming is not finished yet. Also, it's rwp and requires the before in the class, which is far from pretty.

Using MooX modules

An approach that tries to generalise this with a separate module, MooX::Thunking. First, another module to encapsulate overriding of Moo functions:

package MooX::Utils;
use strict;
use warnings;
use Moo ();
use Moo::Role ();
use Carp qw(croak);
use base qw(Exporter);
our @EXPORT = qw(override_function);
sub override_function {
  my ($target, $name, $func) = @_;
  my $orig = $target->can($name) or croak "Override '$target\::$name': not found";
  my $install_tracked = Moo::Role->is_role($target) ? \&Moo::Role::_install_tracked : \&Moo::_install_tracked;
  $install_tracked->($target, $name, sub { $func->($orig, @_) });
}

Now the thunking MooX module itself, which uses the above to override has:

package MooX::Thunking;
use MooX::Utils;
use Types::TypeTiny -all;
use Class::Method::Modifiers qw(install_modifier);
sub import {
  my $target = scalar caller;
  override_function($target, 'has', sub {
    my ($orig, $name, %opts) = @_;
    $orig->($name, %opts), return if $opts{is} ne 'thunked';
    $opts{is} = 'ro';
    $orig->($name, %opts); # so we have method to modify
    install_modifier $target, 'before', $name => sub {
      my $self = shift;
      return if @_; # attempt at setting, hand to auto
      my $value = $self->{$name};
      return if !eval { CodeLike->($value); 1 }; # attempt at reading and already resolved
      $self->{$name} = $value->();
      $opts{isa}->($self->{$name}) if $opts{isa}; # validate
    }
  });
}

This applies "thunking" to an attribute. It will only function if the attribute is ro, and will quietly resolve any CodeLike values on reading. It can be used like this:

package Thunking;
use Moo;
use MooX::Thunking;
use Types::Standard -all;
use Types::Thunking -all;
has attr => (
  is => 'thunked',
  isa => Thunk[ArrayRef],
);

Using BUILDARGS and lazy

An alternative approach, suggested by the mighty @haarg:

package MooX::Thunking;
use MooX::Utils;
use Types::TypeTiny -all;
use Class::Method::Modifiers qw(install_modifier);
sub import {
  my $target = scalar caller;
  override_function($target, 'has', sub {
    my ($orig, $name, %opts) = @_;
    $orig->($name, %opts), return if $opts{is} ne 'thunked';
    $opts{is} = 'lazy';
    my $gen_attr = "_gen_$name";
    $orig->($gen_attr => (is => 'ro'));
    $opts{builder} = sub { $_[0]->$gen_attr->(); };
    install_modifier $target, 'around', 'BUILDARGS' => sub {
      my ($orig, $self) = (shift, shift);
      my $args = $self->$orig(@_);
      $args->{$gen_attr} = delete $args->{$name} if eval { CodeLike->($args->{$name}); 1 };
      return $args;
    };
    $orig->($name, %opts);
  });
}

It uses the built-in lazy mechanism, creating a builder that will call the supplied CodeLike if that is what is given. One important downside is that this technique does not work for Moo::Roles.