我希望能够拥有一个具有以下特征的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,
);

这里需要处理两个问题：延迟计算不可变属性(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- 在这种情况下，不需要其他参数可伸缩性参数。由于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, @_) });
}

现在 thunkingMooX模块本身，它使用上述内容覆盖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
}
});
}

这会将"投掷"应用于属性。它只有在属性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::Role。

如何使用Moo和Type：：Tiny以一般方式实现"thunks"(延迟计算)？

参数化类型

延迟计算不可变属性

幼稚的方法

使用`MooX`模块

使用`BUILDARGS`和`lazy`

相关内容

最新更新

热门标签：

如何使用Moo和Type：：Tiny以一般方式实现"thunks"(延迟计算)？

参数化类型

延迟计算不可变属性

幼稚的方法

使用MooX模块

使用BUILDARGS和lazy

相关内容

最新更新

热门标签：

使用`MooX`模块

使用`BUILDARGS`和`lazy`