use
5.010001;
our
$AUTHORITY
=
'cpan:TOBYINK'
;
our
$VERSION
=
'0.005'
;
use
Data::Sah
qw( gen_validator normalize_schema )
;
sub
sah2type {
state
$pl
=
'Data::Sah'
->new->get_compiler(
"perl"
);
my
(
$schema
,
%opts
) =
@_
;
$schema
= normalize_schema(
$schema
);
return
'Type::Tiny'
->new(
_data_sah
=>
$schema
,
parent
=> (
$schema
->[1]{req} ? Item : Optional[Item] ),
constraint
=>
sub
{
state
$coderef
= gen_validator(
$schema
,
coerce
=> 0 );
@_
=
$_
;
goto
$coderef
},
inlined
=>
sub
{
my
$varname
=
pop
;
my
$cd
;
my
$handle_varname
=
''
;
if
(
$varname
=~ /\A\$([^\W0-9]\w*)\z/ ) {
$cd
=
$pl
->compile(
schema
=>
$schema
,
coerce
=> 0,
data_name
=>
"$1"
);
}
else
{
$cd
=
$pl
->compile(
schema
=>
$schema
,
coerce
=> 0,
data_name
=>
'data'
);
$handle_varname
=
"my \$data = $varname;"
;
}
my
$code
=
$cd
->{result};
my
$load_modules
=
join
''
,
map
$pl
->stmt_require_module(
$_
), @{
$cd
->{modules} };
return
"do { $handle_varname $load_modules $code }"
;
},
constraint_generator
=>
sub
{
my
@params
=
@_
;
my
$new_schema
= [
$schema
->[0], { %{
$schema
->[1] },
@params
} ];
my
$child
= sah2type(
$new_schema
,
parameters
=> \
@params
);
$child
->check(
undef
);
$child
->{parent} =
$Type::Tiny::parameterize_type
;
return
$child
;
},
(
exists
(
$schema
->[1]{
default
})
? (
type_default
=>
sub
{
$schema
->[1]{
default
} } )
: () ),
_build_coercion
=>
sub
{
my
$coercion
=
shift
;
my
$f
= gen_validator(
$schema
, {
return_type
=>
'bool_valid+val'
} );
$coercion
->add_type_coercions(
Item() =>
sub
{
my
(
undef
,
$new
) = @{
$f
->(
$_
) };
return
$new
;
},
);
$coercion
->freeze;
},
%opts
,
);
}
1;