如何使用 Moo 和 Type::Tiny 以通用方式实现 "thunks"(延迟计算)?
How can I implement "thunks" (delayed computation) in a general way using Moo and Type::Tiny?
我希望能够拥有一个具有以下特征的 Moo* class:
- 对象的属性可以存储对对象本身的引用
- 该属性将使用
Type::Tiny
类型进行类型约束,因此引用必须是正确的类型
- class必须在不可变的情况下起作用,并且属性是"required",即未定义的值是不可接受的,以后不能更新
例如
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
is "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] });
虽然这适用于那里的特定类型,但我如何才能拥有实现类似功能的参数化类型?此外,如果这可以挂接到 "lazy" 功能以最大限度地减少存储计算值所涉及的代码,那将更有帮助。
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
一样工作。这些库可以处理任何 "inline" 代码生成。
它可以这么短的原因是 constraint_generator
必须 return 或者 一个代码引用,它可能是一个捕获的闭包传递给它的参数(见下文), 或 只是一个 Type::Tiny
- 在这种情况下不需要 other parameterisability parameters。由于 union
(看起来它通常用于为 declare
生成参数)return 是一个适当构造的 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),
);
};
};
这是我用来测试这些的"harness":
#!/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;
延迟计算不可变属性
为了使其不可变,我们希望将属性设置为失败,除非是我们自己做的。在读取属性的时候,我们想看看有没有计算;如果是,就去做;然后 return 值。
天真的方法
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
并且需要 class 中的 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],
);
使用 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
s。
我希望能够拥有一个具有以下特征的 Moo* class:
- 对象的属性可以存储对对象本身的引用
- 该属性将使用
Type::Tiny
类型进行类型约束,因此引用必须是正确的类型 - class必须在不可变的情况下起作用,并且属性是"required",即未定义的值是不可接受的,以后不能更新
例如
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
is "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] });
虽然这适用于那里的特定类型,但我如何才能拥有实现类似功能的参数化类型?此外,如果这可以挂接到 "lazy" 功能以最大限度地减少存储计算值所涉及的代码,那将更有帮助。
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
一样工作。这些库可以处理任何 "inline" 代码生成。
它可以这么短的原因是 constraint_generator
必须 return 或者 一个代码引用,它可能是一个捕获的闭包传递给它的参数(见下文), 或 只是一个 Type::Tiny
- 在这种情况下不需要 other parameterisability parameters。由于 union
(看起来它通常用于为 declare
生成参数)return 是一个适当构造的 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),
);
};
};
这是我用来测试这些的"harness":
#!/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;
延迟计算不可变属性
为了使其不可变,我们希望将属性设置为失败,除非是我们自己做的。在读取属性的时候,我们想看看有没有计算;如果是,就去做;然后 return 值。
天真的方法
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
并且需要 class 中的 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],
);
使用 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
s。