使用 Type::Tiny 将类型参数化为另一种类型

Question

我想根据字符串创建一个类型，该类型将具有长度上限，并且 - 可选地 - 长度下限。即参数化类型，其中长度范围将是一个参数。
我想要的实现：

• 字符串长度范围的单独类型。
• 不使用 MooseX::Types::Parameterizable
• 使用 arrayref 直接参数化类型的糖，而不是 hashref：
  • 这个：isa=>Varchar[1, 15]
  • 不是这个：isa=>Varchar[{min=>1, max=>15,}]

这就是我目前所拥有的：
文件 MyTypesTiny.pm

package MyTypesTiny;

use strict;
use warnings;

use Type::Library
    -base,
    -declare => qw( VarcharRange Varchar );

use Type::Utils -all;
use Types::Standard -types;
use MooseX::Types::Common::Numeric qw( PositiveOrZeroInt );

declare VarcharRange,
  as HashRef [PositiveOrZeroInt],
  where {
    return 0 if ( grep { $_ ne 'min' && $_ ne 'max' } keys %{$_} );
    return ( $_->{min} <= $_->{max} )
      if ( defined $_->{max} && defined $_->{min} );
    return 1;
  }, message { "$_" };

coerce VarcharRange, from ArrayRef [PositiveOrZeroInt], via {
    my $result;
    my @keys = qw(min max);
    foreach my $val ( reverse @$_ ) {
        my $key = pop @keys // 'bad_range';
        $result->{$key} = $val;
    }
    return $result;
};

1;

文件 test_varchar.pl

#!/usr/bin/env perl

package MyClass;

use Moose;
use MyTypesTiny qw( VarcharRange );

has 'my_range' => (isa=>VarcharRange, is=>'ro', coerce=>1);

package main;
use MyClass;

my $check = MyClass->new( 
    my_range => [1, 15],     # works, as expected
    # my_range => [1, 0],    # fails, as expected
    # my_range => [0, 1, 2], # fails, as expected  
);

好的，VarcharRange 有效。 现在我必须添加 Varchar 本身。这就是我立即卡住的地方：
添加到 MyTypesTiny.pm：

declare Varchar, as Str, where {}, constraint_generator => sub {
    # here I have @_ which is an ArrayRef
    # and I want to create a VarcharRange object $range from it
    # but what exactly should I do?
    return sub {
        my $len = length($_);
        return 0 if ( $range->{min} && $len < $range->{min} );
        return 0 if ( $range->{max} && $len > $range->{max} );
        return 1;
    };
};

我的大脑在沸腾。我已经准备好了 ArrayRef。我所需要的只是一个 VarcharRange（它基本上是一个 HashRef）对象。但是 VarcharRange 是一种类型 - 一个名称标记集合的约束和强制规则。它不对应于对象本身。类型的对象是在创建类属性时创建的，但我这里没有任何类在起作用。

Answer 1

这是一个让您能够为“Varchar”类型提供参数的答案。启用参数化类型的神奇之处在于为类型提供constraint_generator。这个方案没有中间hashref，只有一种类型。

MyTypesTiny.pm:

package MyTypesTiny;

use Types::Standard -all;
use Type::Library -base, -declare => qw(Varchar);
use Type::Utils -all;

sub _get_varchar_args {
  die "can only give 0-2 parameters" if @_ > 2;
  map assert_Int($_), @_;
  return @_ == 1 ? (0, @_) : @_;
}

declare "Varchar",
  as Str,
  constraint_generator => sub {
    my ($min_length, $max_length) = _get_varchar_args(@_);
    return sub {
      length($_) >= $min_length and length($_) <= $max_length;
    };
  },
  inline_generator => sub {
    my ($min_length, $max_length) = _get_varchar_args(@_);
    return sub {
      my ($constraint, $varname) = @_;
      return sprintf(
        'length(%s) >= %d and length(%s) <= %d',
        $varname,
        $min_length,
        $varname,
        $max_length,
      );
    };
  };

1;

MyClass.pm：

package MyClass;

use Moo;
use MyTypesTiny -all;

has my_string  => (
  is => 'ro',
  isa => Varchar[9, 10],
);

1;

tester.pl:

#!perl
use MyClass;
my $check = MyClass->new( my_string => 'ASDef45F%'); # length 9, ok
$check = MyClass->new( my_string => 'f45F%'); # length 5, not ok

Answer 2

这就是我最终的结果。不得不引入额外的课程。它有效，我可能会在这里停下来。

字符串长度范围的类：

package VarcharRange;

use strict;
use warnings;
use Moose;
use Moose::Util::TypeConstraints;

subtype 'AuxRange', as 'HashRef[Int]', where {
    foreach my $range_id ( keys %{$_} ) {
        return 0 if ( $range_id ne 'min' && $range_id ne 'max' );
        return 0 if ( $_->{$range_id} < 0 );
    }
    return ( $_->{min} <= $_->{max} )
      if ( defined $_->{max} && defined $_->{min} );
    return 1;
}, message {
    'invalid VarcharRange'
};

coerce 'AuxRange', from 'ArrayRef[Int]', via {
    my $result;
    my @keys = qw(min max);
    foreach my $val ( reverse @$_ ) {
        my $key = pop @keys // 'bad_range';
        $result->{$key} = $val;
    }
    return $result;
};

has range => (
    isa     => 'AuxRange',
    traits  => ['Hash'],
    coerce  => 1,
    handles => {
        'max' => [ get => 'max' ],
        'min' => [ get => 'min' ],
    },
);

1;

参数化类型：

package MyTypesTiny;

use strict;
use warnings;

use Type::Library
  -base,
  -declare => qw( Varchar );

use Type::Utils -all;
use Types::Standard -types;

use VarcharRange;

declare Varchar, as Str, where {
    1;
}, inline_as {
    my ( $constraint, $varname ) = @_;
    return $constraint->parent->inline_check($varname);
}, constraint_generator => sub {
    my $range = VarcharRange->new( range => \@_ );
    return sub {
        my $len = length($_);
        return 0 if ( $range->min() && $len < $range->min() );
        return 0 if ( $range->max() && $len > $range->max() );
        return 1;
    };
}, inline_generator => sub {
    my $range = VarcharRange->new( range => \@_ );
    return sub {
        my ( $constraint, $varname ) = @_;
        my $check_line;
        $check_line .= "length('$varname') >= $range->min()"
          if ( $range->min() );
        if ( $range->max() ) {
            $check_line .= ' && ' if ( $range->min() );
            $check_line .= "length('$varname') <= $range->max()";
        }
        return $check_line;
    };
};

1;

以及要使用的测试模板：

#!/usr/bin/env perl

package MyClass;

use Moose;
use MyTypesTiny qw( Varchar );

# Varchar        means no length limitation
# Varchar[1, 1]  means min length is 1, max is 1
# Varchar[15]    means min length is 0, max is 15
# Varchar[1, 15] means min length is 1, max is 15

# put your parametrization here
has 'my_string' => ( isa => Varchar [ 9, 10 ], is => 'ro' );

package main;
use MyClass;

# put your test string here
my $check = MyClass->new( my_string => 'ASDef45F%',);