Parametrizing type with another type using Type::T

Question

I want to create a type, based on the string, which will have upper length limit, and - optionally - lower length limit. I.e., parameterized type, where length range would be a parameter.
What I want in my implementation:

• A separate type for string length range.
• Not using MooseX::Types::Parameterizable
• A sugar of parametrizing the type straight with arrayref, NOT hashref:
  • This: isa=>Varchar[1, 15]
  • Not this: isa=>Varchar[{min=>1, max=>15,}]

That's what I have so far:
File 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;

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

Ok, VarcharRange works. Now I have to add Varchar itself. And that's where I get stuck instantly:
added to 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;
    };
};

My brain is boiling. I have my ArrayRef ready. All I need is a VarcharRange (which is basically a HashRef) object to be made from it. But VarcharRange is a type - a name marking set of constraints and coercion rules. It does not correspond to an object per se. Objects for types are created when class attributes are created, but I don't have any class in play here.

Answer 1

This is an answer that gives you the ability to give parameters to the "Varchar" type. The magic that enables parameterised types is to provide a constraint_generator to the type. This solution does not have the intermediate hashref, and it only has one type.

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

That's what I ended up with. Had to introduce an extra class. It works, and I'll probably stop here.

Class for string length range:

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;

Parametrizable type:

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;

And test template to play with:

#!/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%',);