Skip to content

Commit

Permalink
Assign name for anon type
Browse files Browse the repository at this point in the history
  • Loading branch information
kfly8 committed Dec 15, 2024
1 parent 0a74919 commit 34cc556
Show file tree
Hide file tree
Showing 3 changed files with 40 additions and 19 deletions.
14 changes: 11 additions & 3 deletions lib/kura.pm
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,7 @@ sub create_constraint {
my ($constraint, $opts) = @_;

if (my $blessed = Scalar::Util::blessed($constraint)) {
return _create_constraint_from_typetiny($constraint, $opts) if $constraint->isa('Type::Tiny');
return ($constraint, undef) if $constraint->can('check');
return ($constraint, undef) if grep { $constraint->isa($_) } @ALLOWED_CONSTRAINT_CLASSES;
return (undef, "Invalid constraint. Object must have a `check` method or allowed constraint class: $blessed");
Expand All @@ -64,6 +65,15 @@ sub create_constraint {
return (undef, 'Invalid constraint');
}

# Create a constraint object from a Type::Tiny object.
sub _create_constraint_from_typetiny {
my ($type, $opts) = @_;

$type->{name} = $opts->{name} if $type->is_anon;

return ($type, undef);
}

# Create a constraint object from a code reference.
sub _create_constraint_from_coderef {
my ($coderef, $opts) = @_;
Expand All @@ -72,7 +82,6 @@ sub _create_constraint_from_coderef {

my $args = {};
$args->{name} = $opts->{name};
$args->{caller} = $opts->{caller};
$args->{constraint} = sub { !!eval { $coderef->($_[0]) } };
$args->{message} = sub { sprintf('%s did not pass the constraint "%s"', Type::Tiny::_dd($_[0]), $args->{name}) };

Expand All @@ -86,8 +95,7 @@ sub _create_constraint_from_hashref {
my $blessed = delete $args->{blessed} || 'Type::Tiny';
eval "require $blessed" or die $@;

$args->{name} //= $opts->{name};
$args->{caller} //= $opts->{caller};
$args->{name} //= $opts->{name};

return ($blessed->new(%$args), undef);
}
Expand Down
13 changes: 9 additions & 4 deletions t/10-integration/Type-Tiny/TestTypeTiny.pm
Original file line number Diff line number Diff line change
Expand Up @@ -3,14 +3,19 @@ package TestTypeTiny;
use Exporter 'import';
use Types::Standard qw(Str);

use kura Foo => Type::Tiny->new(
use kura NamedType => Type::Tiny->new(
name => 'NamedType',
constraint => sub { length $_ > 0 },
);

use kura Bar => sub { length $_ > 0 };
use kura NoNameType => Type::Tiny->new(
constraint => sub { length $_ > 0 },
);

use kura CodeRefType => sub { length $_ > 0 };

use kura Baz => {
parent => Foo,
use kura HashRefType => {
parent => NamedType,
message => sub { "too short" },
};

Expand Down
32 changes: 20 additions & 12 deletions t/10-integration/Type-Tiny/basic.t
Original file line number Diff line number Diff line change
Expand Up @@ -4,30 +4,38 @@ use Test2::Require::Module 'Type::Tiny', '2.000000';
use FindBin qw($Bin);
use lib "$Bin";

use TestTypeTiny qw(Foo Bar Baz);
use TestTypeTiny qw(NamedType NoNameType CodeRefType HashRefType);

subtest 'Test `kura` with Type::Tiny' => sub {
for my $type (Foo, Bar, Baz) {
for my $type (NamedType, NoNameType, CodeRefType HashRefType) {
ok !$type->check('');
ok $type->check('dog');
}

is Foo, object {
prop blessed => 'Type::Tiny';
call name => '__ANON__';
is NamedType, object {
prop blessed => 'Type::Tiny';
call name => 'NamedType';
call display_name => 'NamedType';
};

is Bar, object {
prop blessed => 'Type::Tiny';
call name => 'Bar';
is NoNameType, object {
prop blessed => 'Type::Tiny';
call name => 'NoNameType';
call display_name => 'NoNameType';
};

is Baz, object {
prop blessed => 'Type::Tiny';
call name => 'Baz';
is CodeRefType, object {
prop blessed => 'Type::Tiny';
call name => 'CodeRefType';
call display_name => 'CodeRefType';
};

is +Baz->validate(''), 'too short', 'Bar has a message';
is HashRefType, object {
prop blessed => 'Type::Tiny';
call name => 'HashRefType';
call display_name => 'HashRefType';
call sub { $_[0]->validate('') }, 'too short';
};
};

done_testing;

0 comments on commit 34cc556

Please sign in to comment.