我怎样才能实现" thunks" (延迟计算)使用Moo和Type :: Tiny的一般方式?

时间:2017-08-24 04:14:35

标签: perl oop moo

我希望能够拥有具有以下特征的Moo *课程:

  • 对象的属性可以存储对象本身的引用
  • 该属性将使用Type::Tiny类型进行类型约束,因此引用必须属于正确的类型
  • 该类必须在不可变时运行,并且该属性为" required",即未定义的值是不可接受的,以后无法更新

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

上面提出了一个鸡与蛋的问题:$type将是未定义的,因此无法通过类型约束。

graphql-js中使用的模式是"thunking"。在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 个答案:

答案 0 :(得分:1)

这里需要解决两个问题:延迟计算不可变属性(DCIA)的参数化Type::Tiny类型约束,以及实际运行的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必须返回 一个代码引用,这可能是一个捕获传递给它的参数的闭包(见下文) ,只需Type::Tiny - 在这种情况下,不需要other parameterisability parameters。由于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应该是相当不言自明的,但你会看到它手动查看对象的hash-ref,这通常是你的编程尚未完成的线索。此外,它是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, @_) });
}

现在是thunking 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],
);

使用BUILDARGSlazy

另一种方法,由强大的@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::Role