diff --git a/lib/Type/Tiny.pm b/lib/Type/Tiny.pm index 8a617231f..22546cca9 100644 --- a/lib/Type/Tiny.pm +++ b/lib/Type/Tiny.pm @@ -558,6 +558,15 @@ sub find_constraining_type { $self; } +sub type_default { + my $self = shift; + return $self->{type_default} if exists $self->{type_default}; + if ( my $parent = $self->parent ) { + return $parent->type_default if $self->_is_null_constraint; + } + return undef; +} + our @CMP; sub CMP_SUPERTYPE () { -1 } @@ -1038,9 +1047,11 @@ sub is_parameterized { if $compiled; $options{inlined} = $self->inline_generator->( @_ ) if $self->has_inline_generator; + $options{type_default} = $self->{type_default_generator}->( @_ ) + if exists $self->{type_default_generator}; # undocumented exists $options{$_} && !defined $options{$_} && delete $options{$_} for keys %options; - + $P = $self->create_child_type( %options ); if ( $self->has_coercion_generator ) { @@ -1769,6 +1780,34 @@ The idea is to allow for: @sorted = Int->sort( 2, 1, 11 ); # => 1, 2, 11 @sorted = Str->sort( 2, 1, 11 ); # => 1, 11, 2 +=item C<< type_default >> + +A coderef which returns a sensible default value for this type. For example, +for a B type, a sensible default might be "0": + + my $Size = Type::Tiny->new( + name => 'Size', + parent => Types::Standard::Enum[ qw( XS S M L XL ) ], + type_default => sub { return 'M'; }, + ); + + package Tshirt { + use Moo; + has size => ( + is => 'ro', + isa => $Size, + default => $Size->type_default, + ); + } + +Child types will inherit a type default from their parent unless the child +has a C. If a type neither has nor inherits a type default, then +calling C will return undef. + +Many of the types defined in L and other bundled type +libraries have type defaults, but discovering them is left as an exercise +for the reader. + =item C<< my_methods >> Experimental hashref of additional methods that can be called on the type diff --git a/lib/Types/Common/Numeric.pm b/lib/Types/Common/Numeric.pm index eba8b3afc..209c28e95 100644 --- a/lib/Types/Common/Numeric.pm +++ b/lib/Types/Common/Numeric.pm @@ -45,6 +45,7 @@ $meta->add_type( constraint => sub { $_ >= 0 }, inlined => sub { undef, qq($_ >= 0) }, message => sub { "Must be a number greater than or equal to zero" }, + type_default => sub { return 0; }, ); my ( $pos_int, $posz_int ); @@ -82,6 +83,7 @@ $meta->add_type( }, message => sub { "Must be an integer greater than or equal to zero" }, $posz_int ? ( compiled_type_constraint => $posz_int ) : (), + type_default => sub { return 0; }, ); $meta->add_type( @@ -98,6 +100,7 @@ $meta->add_type( constraint => sub { $_ <= 0 }, inlined => sub { undef, qq($_ <= 0) }, message => sub { "Must be a number less than or equal to zero" }, + type_default => sub { return 0; }, ); $meta->add_type( @@ -114,6 +117,7 @@ $meta->add_type( constraint => sub { $_ <= 0 }, inlined => sub { undef, qq($_ <= 0) }, message => sub { "Must be an integer less than or equal to zero" }, + type_default => sub { return 0; }, ); $meta->add_type( @@ -122,6 +126,7 @@ $meta->add_type( constraint => sub { $_ >= -9 and $_ <= 9 }, inlined => sub { undef, qq($_ >= -9), qq($_ <= 9) }, message => sub { "Must be a single digit" }, + type_default => sub { return 0; }, ); for my $base ( qw/Num Int/ ) { diff --git a/lib/Types/Common/String.pm b/lib/Types/Common/String.pm index 6fae24162..0b3ec4a5f 100644 --- a/lib/Types/Common/String.pm +++ b/lib/Types/Common/String.pm @@ -41,6 +41,7 @@ $meta->add_type( constraint => sub { length( $_ ) <= 255 and not /\n/ }, inlined => sub { undef, qq(length($_) <= 255), qq($_ !~ /\\n/) }, message => sub { "Must be a single line of no more than 255 chars" }, + type_default => sub { return ''; }, ); $meta->add_type( diff --git a/lib/Types/Standard.pm b/lib/Types/Standard.pm index 277841246..61c942e02 100644 --- a/lib/Types/Standard.pm +++ b/lib/Types/Standard.pm @@ -212,6 +212,7 @@ my $_any = $meta->$add_core_type( name => "Any", inlined => sub { "!!1" }, complement_name => 'None', + type_default => sub { return undef; }, } ); @@ -233,6 +234,7 @@ my $_bool = $meta->$add_core_type( inlined => sub { "!ref $_[1] and (!defined $_[1] or $_[1] eq q() or $_[1] eq '0' or $_[1] eq '1')"; }, + type_default => sub { return !!0; }, } ); @@ -244,6 +246,7 @@ my $_undef = $meta->$add_core_type( parent => $_item, constraint => sub { !defined $_ }, inlined => sub { "!defined($_[1])" }, + type_default => sub { return undef; }, } ); @@ -276,10 +279,11 @@ my $_str = $meta->$add_core_type( constraint => sub { ref( \$_ ) eq 'SCALAR' or ref( \( my $val = $_ ) ) eq 'SCALAR'; }, - inlined => sub { + inlined => sub { "defined($_[1]) and do { ref(\\$_[1]) eq 'SCALAR' or ref(\\(my \$val = $_[1])) eq 'SCALAR' }"; }, - sorter => sub { $_[0] cmp $_[1] } + sorter => sub { $_[0] cmp $_[1] }, + type_default => sub { return ''; }, } ); @@ -296,7 +300,8 @@ my $_laxnum = $meta->add_type( : "defined($_[1]) && !ref($_[1]) && Scalar::Util::looks_like_number($_[1]) && ref(\\($_[1])) ne 'GLOB'" ); }, - sorter => sub { $_[0] <=> $_[1] } + sorter => sub { $_[0] <=> $_[1] }, + type_default => sub { return 0; }, } ); @@ -316,7 +321,7 @@ my $_strictnum = $meta->add_type( \z/x ); }, - inlined => sub { + inlined => sub { 'my $val = ' . $_[1] . ';' . Value()->inline_check( '$val' ) @@ -328,7 +333,8 @@ my $_strictnum = $meta->add_type( (?:[Ee](?:[+-]?[0-9]+))? # matches E1 or e1 or e-1 or e+1 etc \z/x ); ' }, - sorter => sub { $_[0] <=> $_[1] } + sorter => sub { $_[0] <=> $_[1] }, + type_default => sub { return 0; }, } ); @@ -347,6 +353,7 @@ $meta->$add_core_type( inlined => sub { "do { my \$tmp = $_[1]; defined(\$tmp) and !ref(\$tmp) and \$tmp =~ /\\A-?[0-9]+\\z/ }"; }, + type_default => sub { return 0; }, } ); @@ -436,6 +443,7 @@ $meta->$add_core_type( ? "Ref::Util::XS::is_plain_coderef($_[1])" : "ref($_[1]) eq 'CODE'"; }, + type_default => sub { return sub {}; }, } ); @@ -446,13 +454,14 @@ my $_regexp = $meta->$add_core_type( constraint => sub { ref( $_ ) && !!re::is_regexp( $_ ) or blessed( $_ ) && $_->isa( 'Regexp' ); }, - inlined => sub { + inlined => sub { my $v = $_[1]; $maybe_load_modules->( qw/ Scalar::Util re /, "ref($v) && !!re::is_regexp($v) or Scalar::Util::blessed($v) && $v\->isa('Regexp')" ); }, + type_default => sub { return qr//; }, } ); @@ -501,6 +510,11 @@ my $_arr = $meta->$add_core_type( inline_generator => LazyLoad( ArrayRef => 'inline_generator' ), deep_explanation => LazyLoad( ArrayRef => 'deep_explanation' ), coercion_generator => LazyLoad( ArrayRef => 'coercion_generator' ), + type_default => sub { return []; }, + type_default_generator => sub { + return $Type::Tiny::parameterize_type->type_default if @_ < 2; + return undef; + }, } ); @@ -518,6 +532,11 @@ my $_hash = $meta->$add_core_type( inline_generator => LazyLoad( HashRef => 'inline_generator' ), deep_explanation => LazyLoad( HashRef => 'deep_explanation' ), coercion_generator => LazyLoad( HashRef => 'coercion_generator' ), + type_default => sub { return {}; }, + type_default_generator => sub { + return $Type::Tiny::parameterize_type->type_default if @_ < 2; + return undef; + }, my_methods => { hashref_allows_key => LazyLoad( HashRef => 'hashref_allows_key' ), hashref_allows_value => LazyLoad( HashRef => 'hashref_allows_value' ), @@ -535,6 +554,7 @@ $meta->$add_core_type( inline_generator => LazyLoad( ScalarRef => 'inline_generator' ), deep_explanation => LazyLoad( ScalarRef => 'deep_explanation' ), coercion_generator => LazyLoad( ScalarRef => 'coercion_generator' ), + type_default => sub { my $x; return \$x; }, } ); @@ -624,6 +644,10 @@ $meta->$add_core_type( return unless $param->has_coercion; return $param->coercion; }, + type_default => sub { return undef; }, + type_default_generator => sub { + return $Type::Tiny::parameterize_type->type_default; + }, } ); @@ -639,6 +663,9 @@ my $_map = $meta->$add_core_type( hashref_allows_key => LazyLoad( Map => 'hashref_allows_key' ), hashref_allows_value => LazyLoad( Map => 'hashref_allows_value' ), }, + type_default_generator => sub { + return $Type::Tiny::parameterize_type->type_default; + }, } ); diff --git a/lib/Types/TypeTiny.pm b/lib/Types/TypeTiny.pm index b13f36dbd..ca76fbe19 100644 --- a/lib/Types/TypeTiny.pm +++ b/lib/Types/TypeTiny.pm @@ -171,6 +171,7 @@ sub StringLike () { inlined => sub { qq/defined($_[1]) && !ref($_[1]) or Scalar::Util::blessed($_[1]) && ${\ +_get_check_overload_sub() }($_[1], q[""])/; }, + type_default => sub { return '' }, ); if ( __XS ) { my $xsub = Type::Tiny::XS::get_coderef_for( 'StringLike' ); @@ -207,6 +208,7 @@ sub HashLike (;@) { inlined => sub { qq/ref($_[1]) eq q[HASH] or Scalar::Util::blessed($_[1]) && ${\ +_get_check_overload_sub() }($_[1], q[\%{}])/; }, + type_default => sub { return {} }, constraint_generator => sub { my $param = TypeTiny()->assert_coerce( shift ); my $check = $param->compiled_check; @@ -288,6 +290,7 @@ sub ArrayLike (;@) { inlined => sub { qq/ref($_[1]) eq q[ARRAY] or Scalar::Util::blessed($_[1]) && ${\ +_get_check_overload_sub() }($_[1], q[\@{}])/; }, + type_default => sub { return [] }, constraint_generator => sub { my $param = TypeTiny()->assert_coerce( shift ); my $check = $param->compiled_check; @@ -372,6 +375,7 @@ sub CodeLike () { inlined => sub { qq/ref($_[1]) eq q[CODE] or Scalar::Util::blessed($_[1]) && ${\ +_get_check_overload_sub() }($_[1], q[\&{}])/; }, + type_default => sub { return sub {} }, library => __PACKAGE__, ); if ( __XS ) { @@ -406,6 +410,7 @@ sub TypeTiny () { my $var = $_[1]; "Scalar::Util::blessed($var) && $var\->isa(q[Type::Tiny])"; }, + type_default => sub { require Types::Standard; return Types::Standard::Any() }, library => __PACKAGE__, _build_coercion => sub { my $c = shift; diff --git a/t/20-modules/Type-Tiny/type_default.t b/t/20-modules/Type-Tiny/type_default.t new file mode 100644 index 000000000..963ed716d --- /dev/null +++ b/t/20-modules/Type-Tiny/type_default.t @@ -0,0 +1,127 @@ +=pod + +=encoding utf-8 + +=head1 PURPOSE + +Checks Type::Tiny's C attribute works. + +=head1 AUTHOR + +Toby Inkster Etobyink@cpan.orgE. + +=head1 COPYRIGHT AND LICENCE + +This software is copyright (c) 2022 by Toby Inkster. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + +use strict; +use warnings; +use lib qw( ./lib ./t/lib ../inc ./inc ); + +use Test::More; +use Test::Fatal; + +use Types::Standard -types; + +is( + Any->type_default->(), + undef, + 'Any->type_default', +); + +is( + Item->type_default->(), + undef, + 'Item->type_default (inherited from Any)', +); + +is( + Defined->type_default, + undef, + 'Defined->type_default (not inherited from Item)', +); + +is( + Str->type_default->(), + '', + 'Str->type_default', +); + +is( + $_->type_default->(), + 0, + "$_\->type_default", +) for Int, Num, StrictNum, LaxNum; + +is( + Bool->type_default->(), + !!0, + 'Bool->type_default', +); + +is( + Undef->type_default->(), + undef, + 'Undef->type_default', +); + +is( + Maybe->type_default->(), + undef, + 'ArrayRef->type_default', +); + +is( + Maybe->of( Str )->type_default->(), + undef, + 'Maybe[Str]->type_default generated for parameterized type', +); + +is_deeply( + ArrayRef->type_default->(), + [], + 'ArrayRef->type_default', +); + +is_deeply( + ArrayRef->of( Str )->type_default->(), + [], + 'ArrayRef[Str]->type_default generated for parameterized type', +); + +is( + ArrayRef->of( Str, 1, 2 )->type_default, + undef, + 'ArrayRef[Str, 1, 2]->type_default not generated', +); + +is_deeply( + HashRef->type_default->(), + {}, + 'HashRef->type_default', +); + +is_deeply( + HashRef->of( Str )->type_default->(), + {}, + 'HashRef[Str]->type_default generated for parameterized type', +); + +is_deeply( + Map->type_default->(), + {}, + 'Map->type_default', +); + +is_deeply( + Map->of( Str, Int )->type_default->(), + {}, + 'Map[Str, Int]->type_default generated for parameterized type', +); + +done_testing;