[libtype-tiny-perl] 07/14: some initial my_method stuff
Jonas Smedegaard
dr at jones.dk
Fri May 30 17:41:31 UTC 2014
This is an automated email from the git hooks/post-receive script.
js pushed a commit to tag 0.043_03
in repository libtype-tiny-perl.
commit aa38236f88ad3b09b939c40a268e207c21bedf7b
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date: Sat Apr 26 16:18:20 2014 +0100
some initial my_method stuff
---
lib/Type/Tiny.pm | 11 ++++
lib/Types/Standard.pm | 120 ++++++++++++++++++++++++++++++++++
t/20-unit/Types-Standard/structured.t | 95 +++++++++++++++++++++++++++
3 files changed, 226 insertions(+)
diff --git a/lib/Type/Tiny.pm b/lib/Type/Tiny.pm
index 295e669..caa17c3 100644
--- a/lib/Type/Tiny.pm
+++ b/lib/Type/Tiny.pm
@@ -180,6 +180,17 @@ sub new
$self->{type_constraints} ||= undef;
+ if ($params{my_methods} and eval { require Sub::Name })
+ {
+ for my $key (keys %{$params{my_methods}})
+ {
+ Sub::Name::subname(
+ sprintf("%s::my_%s", $self->qualified_name, $key),
+ $params{my_methods}{$key},
+ );
+ }
+ }
+
return $self;
}
diff --git a/lib/Types/Standard.pm b/lib/Types/Standard.pm
index d3ff007..15b92fb 100644
--- a/lib/Types/Standard.pm
+++ b/lib/Types/Standard.pm
@@ -297,6 +297,24 @@ my $_hash = $meta->add_type({
inline_generator => LazyLoad(HashRef => 'inline_generator'),
deep_explanation => LazyLoad(HashRef => 'deep_explanation'),
coercion_generator => LazyLoad(HashRef => 'coercion_generator'),
+ my_methods => {
+ hashref_allows_key => sub {
+ my $self = shift;
+ Str()->check($_[0]);
+ },
+ hashref_allows_value => sub {
+ my $self = shift;
+ my ($key, $value) = @_;
+
+ return !!0 unless $self->my_hashref_allows_key($key);
+ return !!1 if $self==HashRef();
+
+ my $href = $self->find_parent(sub { $_->has_parent && $_->parent==HashRef() });
+ my $param = $href->type_parameter;
+
+ Str()->check($key) and $param->check($value);
+ },
+ },
});
$meta->add_type({
@@ -372,6 +390,32 @@ my $_map = $meta->add_type({
inline_generator => LazyLoad(Map => 'inline_generator'),
deep_explanation => LazyLoad(Map => 'deep_explanation'),
coercion_generator => LazyLoad(Map => 'coercion_generator'),
+ my_methods => {
+ hashref_allows_key => sub {
+ my $self = shift;
+ my ($key) = @_;
+
+ return Str()->check($key) if $self==Map();
+
+ my $map = $self->find_parent(sub { $_->has_parent && $_->parent==Map() });
+ my ($kcheck, $vcheck) = @{ $map->parameters };
+
+ ($kcheck or Any())->check($key);
+ },
+ hashref_allows_value => sub {
+ my $self = shift;
+ my ($key, $value) = @_;
+
+ return !!0 unless $self->my_hashref_allows_key($key);
+ return !!1 if $self==Map();
+
+ my $map = $self->find_parent(sub { $_->has_parent && $_->parent==Map() });
+ my ($kcheck, $vcheck) = @{ $map->parameters };
+
+ ($kcheck or Any())->check($key)
+ and ($vcheck or Any())->check($value);
+ },
+ },
});
my $_Optional = $meta->add_type({
@@ -447,6 +491,82 @@ $meta->add_type({
inline_generator => LazyLoad(Dict => 'inline_generator'),
deep_explanation => LazyLoad(Dict => 'deep_explanation'),
coercion_generator => LazyLoad(Dict => 'coercion_generator'),
+ my_methods => {
+ dict_is_slurpy => sub
+ {
+ my $self = shift;
+
+ return !!0 if $self==Dict();
+
+ my $dict = $self->find_parent(sub { $_->has_parent && $_->parent==Dict() });
+ ref($dict->parameters->[-1]) eq q(HASH)
+ ? $dict->parameters->[-1]{slurpy}
+ : !!0
+ },
+ hashref_allows_key => sub
+ {
+ my $self = shift;
+ my ($key) = @_;
+
+ return Str()->check($key) if $self==Dict();
+
+ my $dict = $self->find_parent(sub { $_->has_parent && $_->parent==Dict() });
+ my %params;
+ my $slurpy = $dict->my_dict_is_slurpy;
+ if ($slurpy)
+ {
+ my @args = @{$dict->parameters};
+ pop @args;
+ %params = @args;
+ }
+ else
+ {
+ %params = @{ $dict->parameters }
+ }
+
+ return !!1
+ if exists($params{$key});
+ return !!0
+ if !$slurpy;
+ return Str()->check($key)
+ if $slurpy==Any() || $slurpy==Item() || $slurpy==Defined() || $slurpy==Ref();
+ return $slurpy->my_hashref_allows_key($key)
+ if $slurpy->is_a_type_of(HashRef());
+ return !!0;
+ },
+ hashref_allows_value => sub
+ {
+ my $self = shift;
+ my ($key, $value) = @_;
+
+ return !!0 unless $self->my_hashref_allows_key($key);
+ return !!1 if $self==Dict();
+
+ my $dict = $self->find_parent(sub { $_->has_parent && $_->parent==Dict() });
+ my %params;
+ my $slurpy = $dict->my_dict_is_slurpy;
+ if ($slurpy)
+ {
+ my @args = @{$dict->parameters};
+ pop @args;
+ %params = @args;
+ }
+ else
+ {
+ %params = @{ $dict->parameters }
+ }
+
+ return !!1
+ if exists($params{$key}) && $params{$key}->check($value);
+ return !!0
+ if !$slurpy;
+ return !!1
+ if $slurpy==Any() || $slurpy==Item() || $slurpy==Defined() || $slurpy==Ref();
+ return $slurpy->my_hashref_allows_value($key, $value)
+ if $slurpy->is_a_type_of(HashRef());
+ return !!0;
+ },
+ },
});
use overload ();
diff --git a/t/20-unit/Types-Standard/structured.t b/t/20-unit/Types-Standard/structured.t
index 3df25d3..0f8b814 100644
--- a/t/20-unit/Types-Standard/structured.t
+++ b/t/20-unit/Types-Standard/structured.t
@@ -162,5 +162,100 @@ should_fail({ foo => 4.2, bar => 6.66, baz => "x" }, $gazetteer);
should_fail({ foo => undef, baz => "x" }, $gazetteer);
should_fail({ baz => "x" }, $gazetteer);
+subtest my_dict_is_slurpy => sub
+{
+ ok(!$struct5->my_dict_is_slurpy, 'On a non-slurpy Dict');
+ ok($gazetteer->my_dict_is_slurpy, 'On a slurpy Dict');
+ ok(!$struct5->create_child_type->my_dict_is_slurpy, 'On a child of a non-slurpy Dict');
+ ok($gazetteer->create_child_type->my_dict_is_slurpy, 'On a child of a slurpy Dict');
+};
+
+subtest my_hashref_allows_key => sub
+{
+ ok(HashRef->my_hashref_allows_key('foo'), 'HashRef allows key "foo"');
+ ok(!HashRef->my_hashref_allows_key(undef), 'HashRef disallows key undef');
+ ok(!HashRef->my_hashref_allows_key([]), 'HashRef disallows key []');
+ ok((HashRef[Int])->my_hashref_allows_key('foo'), 'HashRef[Int] allows key "foo"');
+ ok(!(HashRef[Int])->my_hashref_allows_key(undef), 'HashRef[Int] disallows key undef');
+ ok(!(HashRef[Int])->my_hashref_allows_key([]), 'HashRef[Int] disallows key []');
+ ok(Map->my_hashref_allows_key('foo'), 'Map allows key "foo"');
+ ok(!Map->my_hashref_allows_key(undef), 'Map disallows key undef');
+ ok(!Map->my_hashref_allows_key([]), 'Map disallows key []');
+ ok(!(Map[Int,Int])->my_hashref_allows_key('foo'), 'Map[Int,Int] disallows key "foo"');
+ ok(!(Map[Int,Int])->my_hashref_allows_key(undef), 'Map[Int,Int] disallows key undef');
+ ok(!(Map[Int,Int])->my_hashref_allows_key([]), 'Map[Int,Int] disallows key []');
+ ok((Map[Int,Int])->my_hashref_allows_key('42'), 'Map[Int,Int] allows key "42"');
+ ok(Dict->my_hashref_allows_key('foo'), 'Dict allows key "foo"');
+ ok(!Dict->my_hashref_allows_key(undef), 'Dict disallows key undef');
+ ok(!Dict->my_hashref_allows_key([]), 'Dict disallows key []');
+ ok(!(Dict[])->my_hashref_allows_key('foo'), 'Dict[] disallows key "foo"');
+ ok(!(Dict[])->my_hashref_allows_key(undef), 'Dict[] disallows key undef');
+ ok(!(Dict[])->my_hashref_allows_key([]), 'Dict[] disallows key []');
+ ok(!(Dict[bar=>Int])->my_hashref_allows_key('foo'), 'Dict[bar=>Int] disallows key "foo"');
+ ok((Dict[bar=>Int])->my_hashref_allows_key('bar'), 'Dict[bar=>Int] allows key "bar"');
+ ok(!(Dict[bar=>Int])->my_hashref_allows_key(undef), 'Dict[bar=>Int] disallows key undef');
+ ok(!(Dict[bar=>Int])->my_hashref_allows_key([]), 'Dict[bar=>Int] disallows key []');
+ ok((Dict[bar=>Int, slurpy Any])->my_hashref_allows_key('foo'), 'Dict[bar=>Int,slurpy Any] allows key "foo"');
+ ok((Dict[bar=>Int, slurpy Any])->my_hashref_allows_key('bar'), 'Dict[bar=>Int,slurpy Any] allows key "bar"');
+ ok(!(Dict[bar=>Int, slurpy Any])->my_hashref_allows_key(undef), 'Dict[bar=>Int,slurpy Any] disallows key undef');
+ ok(!(Dict[bar=>Int, slurpy Any])->my_hashref_allows_key([]), 'Dict[bar=>Int,slurpy Any] disallows key []');
+ ok((Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key('foo'), 'Dict[bar=>Int,slurpy Ref] allows key "foo"');
+ ok((Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key('bar'), 'Dict[bar=>Int,slurpy Ref] allows key "bar"');
+ ok(!(Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key(undef), 'Dict[bar=>Int,slurpy Ref] disallows key undef');
+ ok(!(Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key([]), 'Dict[bar=>Int,slurpy Ref] disallows key []');
+ ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key('foo'), 'Dict[bar=>Int,slurpy Map[Int,Int]] disallows key "foo"');
+ ok((Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key('bar'), 'Dict[bar=>Int,slurpy Map[Int,Int]] allows key "bar"');
+ ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key(undef), 'Dict[bar=>Int,slurpy Map[Int,Int]] disallows key undef');
+ ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key([]), 'Dict[bar=>Int,slurpy Map[Int,Int]] disallows key []');
+ ok((Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key('42'), 'Dict[bar=>Int,slurpy Map[Int,Int]] allows key "42"');
+ ok(HashRef->create_child_type->my_hashref_allows_key('foo'), 'A child of HashRef allows key "foo"');
+ ok(!HashRef->create_child_type->my_hashref_allows_key(undef), 'A child of HashRef disallows key undef');
+ ok(!HashRef->create_child_type->my_hashref_allows_key([]), 'A child of HashRef disallows key []');
+ ok((HashRef[Int])->create_child_type->my_hashref_allows_key('foo'), 'A child of HashRef[Int] allows key "foo"');
+ ok(!(HashRef[Int])->create_child_type->my_hashref_allows_key(undef), 'A child of HashRef[Int] disallows key undef');
+ ok(!(HashRef[Int])->create_child_type->my_hashref_allows_key([]), 'A child of HashRef[Int] disallows key []');
+ ok(Map->create_child_type->my_hashref_allows_key('foo'), 'A child of Map allows key "foo"');
+ ok(!Map->create_child_type->my_hashref_allows_key(undef), 'A child of Map disallows key undef');
+ ok(!Map->create_child_type->my_hashref_allows_key([]), 'A child of Map disallows key []');
+ ok(!(Map[Int,Int])->create_child_type->my_hashref_allows_key('foo'), 'A child of Map[Int,Int] disallows key "foo"');
+ ok(!(Map[Int,Int])->create_child_type->my_hashref_allows_key(undef), 'A child of Map[Int,Int] disallows key undef');
+ ok(!(Map[Int,Int])->create_child_type->my_hashref_allows_key([]), 'A child of Map[Int,Int] disallows key []');
+ ok((Map[Int,Int])->create_child_type->my_hashref_allows_key('42'), 'A child of Map[Int,Int] allows key "42"');
+ ok(Dict->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict allows key "foo"');
+ ok(!Dict->create_child_type->my_hashref_allows_key(undef), 'A child of Dict disallows key undef');
+ ok(!Dict->create_child_type->my_hashref_allows_key([]), 'A child of Dict disallows key []');
+ ok(!(Dict[])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[] disallows key "foo"');
+ ok(!(Dict[])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[] disallows key undef');
+ ok(!(Dict[])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[] disallows key []');
+ ok(!(Dict[bar=>Int])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[bar=>Int] disallows key "foo"');
+ ok((Dict[bar=>Int])->create_child_type->my_hashref_allows_key('bar'), 'A child of Dict[bar=>Int] allows key "bar"');
+ ok(!(Dict[bar=>Int])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[bar=>Int] disallows key undef');
+ ok(!(Dict[bar=>Int])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[bar=>Int] disallows key []');
+ ok((Dict[bar=>Int, slurpy Any])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[bar=>Int,slurpy Any] allows key "foo"');
+ ok((Dict[bar=>Int, slurpy Any])->create_child_type->my_hashref_allows_key('bar'), 'A child of Dict[bar=>Int,slurpy Any] allows key "bar"');
+ ok(!(Dict[bar=>Int, slurpy Any])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[bar=>Int,slurpy Any] disallows key undef');
+ ok(!(Dict[bar=>Int, slurpy Any])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[bar=>Int,slurpy Any] disallows key []');
+ ok((Dict[bar=>Int, slurpy Ref])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[bar=>Int,slurpy Ref] allows key "foo"');
+ ok((Dict[bar=>Int, slurpy Ref])->create_child_type->my_hashref_allows_key('bar'), 'A child of Dict[bar=>Int,slurpy Ref] allows key "bar"');
+ ok(!(Dict[bar=>Int, slurpy Ref])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[bar=>Int,slurpy Ref] disallows key undef');
+ ok(!(Dict[bar=>Int, slurpy Ref])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[bar=>Int,slurpy Ref] disallows key []');
+ ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] disallows key "foo"');
+ ok((Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key('bar'), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] allows key "bar"');
+ ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] disallows key undef');
+ ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] disallows key []');
+ ok((Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key('42'), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] allows key "42"');
+};
+
+# This could probably be expanded...
+subtest my_hashref_allows_value => sub
+{
+ ok(HashRef->my_hashref_allows_value(foo => "bar"), 'HashRef allows key "foo" with value "bar"');
+ ok(HashRef->my_hashref_allows_value(foo => undef), 'HashRef allows key "foo" with value undef');
+ ok(!HashRef->my_hashref_allows_value(undef, "bar"), 'HashRef disallows key undef with value "bar"');
+ ok(!(HashRef[Int])->my_hashref_allows_value(foo => "bar"), 'HashRef[Int] disallows key "foo" with value "bar"');
+ ok((Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_value(bar => 42), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] allows key "bar" with value 42');
+ ok((Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_value(21, 42), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] allows key "21" with value 42');
+ ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_value(baz => 42), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] disallows key "baz" with value 42');
+};
done_testing;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libtype-tiny-perl.git
More information about the Pkg-perl-cvs-commits
mailing list