diff --git a/README.md b/README.md index 6bddc2d..207db28 100644 --- a/README.md +++ b/README.md @@ -22,24 +22,57 @@ This module is useful for storing constraints in a package and exporting them to - Simple Declaration - Export Constraints -- Store Multiple Constraints +- Store Favorite Constraints ## FEATURES ### Simple Declaration -Kura makes it easy to store constraints in a package. - ```perl use kura NAME => CONSTRAINT; ``` -`CONSTRAINT` must be a any object that has a `check` method or a code reference that returns true or false. -The following is an example of a constraint declaration: +Kura makes it easy to declare constraints. This usage is same as [constant](https://metacpan.org/pod/constant) pragma! +Default implementation of `CONSTRAINT` can accept following these types: -```perl -use kura Name => StrLength[1, 255]; -``` +- Object having a `check` method + + Many constraint libraries has a `check` method, such as [Type::Tiny](https://metacpan.org/pod/Type%3A%3ATiny), [Moose::Meta::TypeConstraint](https://metacpan.org/pod/Moose%3A%3AMeta%3A%3ATypeConstraint), [Mouse::Meta::TypeConstraint](https://metacpan.org/pod/Mouse%3A%3AMeta%3A%3ATypeConstraint), [Specio](https://metacpan.org/pod/Specio) and more. Kura accepts these objects. + + ```perl + use Types::Common -types; + use kura Name => StrLength[1, 255]; + ``` + +- Allowed constraint classes + + Kura allows these classes: [Data::Validator](https://metacpan.org/pod/Data%3A%3AValidator), [Poz::Types](https://metacpan.org/pod/Poz%3A%3ATypes). Here is an example of using [Poz](https://metacpan.org/pod/Poz): + + ```perl + use Poz qw(z); + use kura Name => z->string->min(1)->max(255); + ``` + +- Code reference + + Code reference makes Type::Tiny object internally. + + ```perl + use kura Name => sub { length($_[0]) > 0 }; + # => Name isa Type::Tiny and check method equals to this coderef. + ``` + +- Hash reference + + Hash reference also makes Type::Tiny object internally. + + ```perl + use kura Name => { + constraint => sub { length($_[0]) > 0, + message => sub { 'Invalid name' }, + }; + # => Name isa Type::Tiny + ``` ### Export Constraints @@ -58,9 +91,9 @@ Foo->check('foo'); # true Foo->check('bar'); # false ``` -### Store Multiple Constraints +### Store Favorite Constraints -Kura supports multiple constraints such as [Data::Checks](https://metacpan.org/pod/Data%3A%3AChecks), [Type::Tiny](https://metacpan.org/pod/Type%3A%3ATiny), [Moose::Meta::TypeConstraint](https://metacpan.org/pod/Moose%3A%3AMeta%3A%3ATypeConstraint), [Mouse::Meta::TypeConstraint](https://metacpan.org/pod/Mouse%3A%3AMeta%3A%3ATypeConstraint), [Specio](https://metacpan.org/pod/Specio), and more. +Kura stores your favorite constraints such as [Data::Checks](https://metacpan.org/pod/Data%3A%3AChecks), [Type::Tiny](https://metacpan.org/pod/Type%3A%3ATiny), [Moose::Meta::TypeConstraint](https://metacpan.org/pod/Moose%3A%3AMeta%3A%3ATypeConstraint), [Mouse::Meta::TypeConstraint](https://metacpan.org/pod/Mouse%3A%3AMeta%3A%3ATypeConstraint), [Specio](https://metacpan.org/pod/Specio), [Data::Validator](https://metacpan.org/pod/Data%3A%3AValidator), [Poz::Types](https://metacpan.org/pod/Poz%3A%3ATypes) and more. ``` Data::Checks -----------------> +--------+ @@ -164,8 +197,7 @@ Kura serves a similar purpose to [Type::Library](https://metacpan.org/pod/Type%3 - Multiple Constraints - Kura is not limited to Type::Tiny. It supports multiple constraint libraries such as Moose, Mouse, Specio, and Data::Checks. - This flexibility allows consistent management of type constraints in projects that mix different libraries. + Kura is not limited to Type::Tiny. It supports multiple constraint libraries such as Moose, Mouse, Specio, Data::Checks and more. This flexibility allows consistent management of type constraints in projects that mix different libraries. While Type::Library is powerful and versatile, Kura stands out for its simplicity, flexibility, and ability to integrate with multiple constraint systems. It’s particularly useful in projects where multiple type constraint libraries coexist or when leveraging built-in class syntax. @@ -252,6 +284,40 @@ use kura _PrivateFoo => Str; # => "_PrivateFoo" is not exported ``` +## Customizing Constraints + +If you want to customize constraints, `create_constraint` function is a hook point. You can override this function to customize constraints. +Following are examples of customizing constraints: + +```perl +package mykura { + use kura (); + use MyConstraint; + + sub import { + shift; + my ($name, $args) = @_; + + my $caller = caller; + + no strict 'refs'; + local *{"kura::create_constraint"} = \&create_constraint; + + kura->import_into($caller, $name, $args); + } + + sub create_constraint { + my ($args, $opts) = @_; + return (undef, "Invalid mykura arguments") unless (ref $args||'') eq 'HASH'; + return (MyConstraint->new(%$args), undef); + } +} + +package main { + use mykura Name => { constraint => sub { length($_[0]) > 0 } }; +} +``` + # LICENSE Copyright (C) kobaken. diff --git a/lib/kura.pm b/lib/kura.pm index 707aaa3..3428347 100644 --- a/lib/kura.pm +++ b/lib/kura.pm @@ -13,18 +13,10 @@ my %FORBIDDEN_NAME = map { $_ => 1 } qw{ AUTOLOAD STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; -# This is a default constraint code to object. -# You can change this code by setting $kura::CALLABLE_TO_OBJECT. -# -# NOTE: This variable will probably change. Use caution when overriding it. -our $CALLABLE_TO_OBJECT = sub { - my ($name, $constraint, $caller) = @_; - - require Type::Tiny; - Type::Tiny->new( - constraint => $constraint, - ); -}; +my @ALLOWED_CONSTRAINT_CLASSES = qw( + Data::Validator + Poz::Types +); sub import { my $pkg = shift; @@ -38,18 +30,73 @@ sub import_into { my $pkg = shift; my ($caller, $name, $constraint) = @_; - my ($kura_item, $err) = _new_kura_item($name, $constraint, $caller); + my ($kura_item, $err) = _new_kura_item($caller, $name, $constraint); Carp::croak $err if $err; _save_kura_item($kura_item, $caller); _save_inc($caller); } +# Create a constraint object. +# +# @param $constraint Defined. Following `create_constraint` function allows these types: Object, CodeRef, HashRef. +# @param $opts Dict[name => Str, caller => Str] +# @return ($constraint, undef) | (undef, $error_message) +# +# NOTE: This function is a hook point. If you want to customize the constraint object, you can override this function. +sub create_constraint { + my ($constraint, $opts) = @_; + + if (my $blessed = Scalar::Util::blessed($constraint)) { + 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"); + } + elsif (my $reftype = Scalar::Util::reftype($constraint)) { + if ($reftype eq 'CODE') { + return _create_constraint_from_coderef($constraint, $opts); + } + elsif ($reftype eq 'HASH') { + return _create_constraint_from_hashref($constraint, $opts); + } + } + + return (undef, 'Invalid constraint'); +} + +# Create a constraint object from a code reference. +sub _create_constraint_from_coderef { + my ($coderef, $opts) = @_; + + require Type::Tiny; + + 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}) }; + + return (Type::Tiny->new(%$args), undef); +} + +# Create a constraint object from a hash reference. +sub _create_constraint_from_hashref { + my ($args, $opts) = @_; + + my $blessed = delete $args->{blessed} || 'Type::Tiny'; + eval "require $blessed" or die $@; + + $args->{name} //= $opts->{name}; + $args->{caller} //= $opts->{caller}; + + return ($blessed->new(%$args), undef); +} + # Create a new kura item which is Dict[name => Str, code => CodeRef]. # If the name or constraint is invalid, it returns (undef, $error_message). # Otherwise, it returns ($kura_item, undef). sub _new_kura_item { - my ($name, $constraint, $caller) = @_; + my ($caller, $name, $constraint) = @_; { return (undef, 'name is required') if !defined $name; @@ -57,19 +104,9 @@ sub _new_kura_item { return (undef, "'$name' is already defined") if $caller->can($name); } - { - return (undef, 'constraint is required') if !defined $constraint; - - if (Scalar::Util::blessed($constraint)) { - return (undef, 'Invalid constraint. It requires a `check` method.') if !$constraint->can('check'); - } - elsif ( (Scalar::Util::reftype($constraint)||'') eq 'CODE') { - $constraint = $CALLABLE_TO_OBJECT->($name, $constraint, $caller); - } - else { - return (undef, 'Invalid constraint. It must be an object that has a `check` method or a code reference.'); - } - } + return (undef, 'constraint is required') if !defined $constraint; + ($constraint, my $err) = create_constraint($constraint, { name => $name, caller => $caller }); + return (undef, $err) if $err; # Prefix '_' means private, so it is not exported. my $is_private = $name =~ /^_/ ? 1 : 0; @@ -137,7 +174,7 @@ This module is useful for storing constraints in a package and exporting them to =item * Export Constraints -=item * Store Multiple Constraints +=item * Store Favorite Constraints =back @@ -145,15 +182,46 @@ This module is useful for storing constraints in a package and exporting them to =head3 Simple Declaration -Kura makes it easy to store constraints in a package. - use kura NAME => CONSTRAINT; -C must be a any object that has a C method or a code reference that returns true or false. -The following is an example of a constraint declaration: +Kura makes it easy to declare constraints. This usage is same as L pragma! +Default implementation of C can accept following these types: + +=over 2 + +=item Object having a C method +Many constraint libraries has a C method, such as L, L, L, L and more. Kura accepts these objects. + + use Types::Common -types; use kura Name => StrLength[1, 255]; +=item Allowed constraint classes + +Kura allows these classes: L, L. Here is an example of using L: + + use Poz qw(z); + use kura Name => z->string->min(1)->max(255); + +=item Code reference + +Code reference makes Type::Tiny object internally. + + use kura Name => sub { length($_[0]) > 0 }; + # => Name isa Type::Tiny and check method equals to this coderef. + +=item Hash reference + +Hash reference also makes Type::Tiny object internally. + + use kura Name => { + constraint => sub { length($_[0]) > 0, + message => sub { 'Invalid name' }, + }; + # => Name isa Type::Tiny + +=back + =head3 Export Constraints Kura allows you to export constraints to other packages using your favorite exporter such as L, L, and more. @@ -169,9 +237,9 @@ Kura allows you to export constraints to other packages using your favorite expo Foo->check('foo'); # true Foo->check('bar'); # false -=head3 Store Multiple Constraints +=head3 Store Favorite Constraints -Kura supports multiple constraints such as L, L, L, L, L, and more. +Kura stores your favorite constraints such as L, L, L, L, L, L, L and more. Data::Checks -----------------> +--------+ | | @@ -267,8 +335,7 @@ This keeps your namespace cleaner and focuses on the essential C method. =item * Multiple Constraints -Kura is not limited to Type::Tiny. It supports multiple constraint libraries such as Moose, Mouse, Specio, and Data::Checks. -This flexibility allows consistent management of type constraints in projects that mix different libraries. +Kura is not limited to Type::Tiny. It supports multiple constraint libraries such as Moose, Mouse, Specio, Data::Checks and more. This flexibility allows consistent management of type constraints in projects that mix different libraries. =back @@ -348,6 +415,38 @@ If you don't want to export constraints, put a prefix C<_> to the constraint nam use kura _PrivateFoo => Str; # => "_PrivateFoo" is not exported +=head2 Customizing Constraints + +If you want to customize constraints, C function is a hook point. You can override this function to customize constraints. +Following are examples of customizing constraints: + + package mykura { + use kura (); + use MyConstraint; + + sub import { + shift; + my ($name, $args) = @_; + + my $caller = caller; + + no strict 'refs'; + local *{"kura::create_constraint"} = \&create_constraint; + + kura->import_into($caller, $name, $args); + } + + sub create_constraint { + my ($args, $opts) = @_; + return (undef, "Invalid mykura arguments") unless (ref $args||'') eq 'HASH'; + return (MyConstraint->new(%$args), undef); + } + } + + package main { + use mykura Name => { constraint => sub { length($_[0]) > 0 } }; + } + =head1 LICENSE Copyright (C) kobaken. diff --git a/t/01-kura.t b/t/01-kura.t index 038daa5..dd0e1df 100644 --- a/t/01-kura.t +++ b/t/01-kura.t @@ -56,10 +56,10 @@ subtest 'Test `kura` exceptions' => sub { subtest 'Invalid constraint' => sub { eval "use kura Bar => 1"; - like $@, qr/^Invalid constraint. It must be an object that has a `check` method or a code reference./; + like $@, qr/^Invalid constraint/; eval "use kura Bar => (bless {}, 'SomeObject')"; - like $@, qr/^Invalid constraint. It requires a `check` method./; + like $@, qr/^Invalid constraint. Object must have a `check` method or allowed constraint class: SomeObject/; }; subtest 'Invalid orders' => sub { diff --git a/t/02-import_into.t b/t/02-import_into.t index 4c10973..968ef02 100644 --- a/t/02-import_into.t +++ b/t/02-import_into.t @@ -1,14 +1,18 @@ use Test2::V0; use lib './t/lib'; -use MyConstraint; subtest 'Test `import_into` method' => sub { subtest 'Customize the import method to your taste' => sub { - use mykura Foo => MyConstraint->new; + use mykura Foo => { a => 1, b => 2 }; - # MyKura customize the name of the constraint - isa_ok MyFoo, 'MyConstraint'; + isa_ok Foo, 'MyConstraint'; + + is Foo->{a}, 1; + is Foo->{b}, 2; + + eval 'use mykura Bar => 1'; + like $@, qr/^Invalid mykura arguments/; } }; diff --git a/t/10-integration/Data-Validator/TestDataValidator.pm b/t/10-integration/Data-Validator/TestDataValidator.pm new file mode 100644 index 0000000..724db47 --- /dev/null +++ b/t/10-integration/Data-Validator/TestDataValidator.pm @@ -0,0 +1,11 @@ +package TestDataValidator; + +use Exporter 'import'; +use Data::Validator; + +use kura Book => Data::Validator->new( + title => 'Str', + author => 'Str', +); + +1; diff --git a/t/10-integration/Data-Validator/basic.t b/t/10-integration/Data-Validator/basic.t new file mode 100644 index 0000000..a2fa04b --- /dev/null +++ b/t/10-integration/Data-Validator/basic.t @@ -0,0 +1,24 @@ +use Test2::V0; +use Test2::Require::Module 'Poz', '0.02'; + +use FindBin qw($Bin); +use lib "$Bin"; + +use TestDataValidator qw(Book); + +subtest 'Test `kura` with Data::Validator' => sub { + isa_ok Book, 'Data::Validator'; + + my $data = { title => "Spidering Hacks", author => "Kevin Hemenway" }; + + my $got = Book->validate($data); + is $got, $data; + + ok dies { + Book->validate({ + isbn => "978-0-596-00797-3", + }); + }; +}; + +done_testing; diff --git a/t/10-integration/Poz/TestPoz.pm b/t/10-integration/Poz/TestPoz.pm new file mode 100644 index 0000000..e0647f8 --- /dev/null +++ b/t/10-integration/Poz/TestPoz.pm @@ -0,0 +1,16 @@ +package TestPoz; + +use Exporter 'import'; +use Poz qw(z); + +use kura Title => z->string->min(1)->max(255); +use kura Author => z->string->default("Anonymous"); +use kura Published => z->date; + +use kura Book => z->object({ + title => Title, + author => Author, + published => Published, +})->as("My::Book"); + +1; diff --git a/t/10-integration/Poz/basic.t b/t/10-integration/Poz/basic.t new file mode 100644 index 0000000..518f494 --- /dev/null +++ b/t/10-integration/Poz/basic.t @@ -0,0 +1,21 @@ +use Test2::V0; +use Test2::Require::Module 'Poz', '0.02'; + +use FindBin qw($Bin); +use lib "$Bin"; + +use TestPoz qw(Book); + +subtest 'Test `kura` with Poz' => sub { + isa_ok Book, 'Poz::Types::object'; + + my $book = Book->parse({ + title => "Spidering Hacks", + author => "Kevin Hemenway", + published => "2003-10-01", + }); + + ok $book->isa('My::Book'); +}; + +done_testing; diff --git a/t/10-integration/Type-Tiny/TestTypeTiny.pm b/t/10-integration/Type-Tiny/TestTypeTiny.pm index b64ad63..fde5e64 100644 --- a/t/10-integration/Type-Tiny/TestTypeTiny.pm +++ b/t/10-integration/Type-Tiny/TestTypeTiny.pm @@ -3,6 +3,15 @@ package TestTypeTiny; use Exporter 'import'; use Types::Standard qw(Str); -use kura Foo => Str & sub { length $_ > 0 }; +use kura Foo => Type::Tiny->new( + constraint => sub { length $_ > 0 }, +); + +use kura Bar => sub { length $_ > 0 }; + +use kura Baz => { + parent => Foo, + message => sub { "too short" }, +}; 1; diff --git a/t/10-integration/Type-Tiny/basic.t b/t/10-integration/Type-Tiny/basic.t index 9806493..8e31883 100644 --- a/t/10-integration/Type-Tiny/basic.t +++ b/t/10-integration/Type-Tiny/basic.t @@ -4,13 +4,30 @@ use Test2::Require::Module 'Type::Tiny', '2.000000'; use FindBin qw($Bin); use lib "$Bin"; -use TestTypeTiny qw(Foo); +use TestTypeTiny qw(Foo Bar Baz); subtest 'Test `kura` with Type::Tiny' => sub { - isa_ok Foo, 'Type::Tiny'; + for my $type (Foo, Bar, Baz) { + ok !$type->check(''); + ok $type->check('dog'); + } - ok !Foo->check(''); - ok Foo->check('hoge'); + is Foo, object { + prop blessed => 'Type::Tiny'; + call name => '__ANON__'; + }; + + is Bar, object { + prop blessed => 'Type::Tiny'; + call name => 'Bar'; + }; + + is Baz, object { + prop blessed => 'Type::Tiny'; + call name => 'Baz'; + }; + + is +Baz->validate(''), 'too short', 'Bar has a message'; }; done_testing; diff --git a/t/lib/MyConstraint.pm b/t/lib/MyConstraint.pm index 9e9601e..ccf4663 100644 --- a/t/lib/MyConstraint.pm +++ b/t/lib/MyConstraint.pm @@ -1,6 +1,10 @@ package MyConstraint; -sub new { bless {}, shift } +sub new { + my ($class, %args) = @_; + bless \%args, $class; +} + sub check { 1 } 1; diff --git a/t/lib/mykura.pm b/t/lib/mykura.pm index ac28b5b..fbf6542 100644 --- a/t/lib/mykura.pm +++ b/t/lib/mykura.pm @@ -3,16 +3,24 @@ use strict; use warnings; use kura (); +use MyConstraint; sub import { - my $class = shift; + shift; + my ($name, $args) = @_; + my $caller = caller; - my ($name, $constraint) = @_; + no strict 'refs'; + local *{"kura::create_constraint"} = \&create_constraint; - $name = 'My' . $name; + kura->import_into($caller, $name, $args); +} - kura->import_into($caller, $name, $constraint); +sub create_constraint { + my ($args, $opts) = @_; + return (undef, "Invalid mykura arguments") unless (ref $args||'') eq 'HASH'; + return (MyConstraint->new(%$args), undef); } 1;