Как я могу реализовать "thunks" (отложенные вычисления) обычным способом, используя Moo и Type::Tiny?

Я хочу иметь возможность иметь класс Moo* со следующими характеристиками:

  • атрибут объекта может хранить ссылку на сам объект
  • этот атрибут будет ограничен по типу, используя Type::Tiny тип, так что ссылка должна быть правильного типа
  • класс должен функционировать, когда он неизменен, а атрибут "обязателен", то есть неопределенное значение недопустимо и не может быть обновлено позже

Например

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]);

Вышеизложенное представляет проблему курицы и яйца: $type будет неопределенным и, следовательно, потеряет ограничение типа.

Шаблон, используемый в graphql-js "гремит". В терминах Perl:

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] });

Хотя это работает для определенного типа, как я могу иметь параметризованный тип, который реализует что-то вроде этого? Кроме того, это поможет еще больше, если это поможет подключиться к "ленивым" функциям, чтобы минимизировать код, связанный с сохранением вычисленного значения.

package Thunking;

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

has [qw(children)] => (
  is => 'lazy',
  isa => Thunk[ArrayRef[InstanceOf['GraphQLType']]],
  required => 1,
);
Источник

1 ответ

Здесь необходимо решить две проблемы: параметризованный Type::Tiny ограничение типа для неизменяемого атрибута с отложенными вычислениями (DCIA) и реально функционирующего DCIA.

Параметризованный тип

Поскольку это Perl, существует несколько способов сделать это. Сердце создания параметризованного типа в Type::Tiny это обеспечить constraint_generator параметр. Самый идиоматичный способ сделать это, используя только Type::Tiny Компоненты, это:

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

Это оно! Если параметры не заданы, он работает так же, как CodeLike, Библиотеки могут позаботиться о создании любого "встроенного" кода.

Причина может быть настолько короткой, что constraint_generator должен возвращать либо code-ref, который, вероятно, будет закрытием, которое фиксирует переданные ему параметры (см. ниже), либо просто Type::Tiny - в этом случае другие параметры параметризуемости не нужны. поскольку union (похоже, он обычно предназначен для создания аргументов declare) возвращает соответственно построенный Type::Tiny::UnionПросто валится отлично.

Более прописанная версия, не использующая тип объединения (и для краткости, использующая CodeRef не 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),
      );
    };
  };

Это "жгут", который я использовал для тестирования этих:

#!/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;

Атрибут неизменяемого вычисления

Чтобы сделать это неизменным, мы хотим, чтобы атрибут не выполнялся, если это не мы. При чтении атрибута мы хотим посмотреть, нужно ли выполнять вычисления; если да, сделай это; затем верните значение.

Наивный подход

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->());
}

before должно быть достаточно понятным, но вы увидите, что он вручную выглядит в хеш-рефере объекта, который обычно указывает на то, что ваше программирование еще не закончено. Кроме того, это rwp и требует before в классе, что далеко не красиво.

С помощью MooX модули

Подход, который пытается обобщить это с помощью отдельного модуля, MooX::Thunking, Во-первых, еще один модуль для инкапсуляции переопределения Moo функции:

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, @_) });
}

Теперь гром MooX сам модуль, который использует вышеуказанное для переопределения 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
    }
  });
}

Это применяет "thunking" к атрибуту. Он будет функционировать только если атрибут roи спокойно разрешит любой CodeLike значения на чтение. Это можно использовать так:

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

С помощью BUILDARGS а также lazy

Альтернативный подход, предложенный могущественным @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);
  });
}

Он использует встроенный lazy механизм, создающий builder это будет называть поставленный CodeLike если это то, что дается. Одним из важных недостатков является то, что этот метод не работает для Moo::Roles.

Источник
Другие вопросы по тегам