summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2019-07-29 17:19:41 +0200
committerYorhel <git@yorhel.nl>2019-07-29 17:19:41 +0200
commit0fc969cdc0ec13bbd01344ed7e1b666264df8de4 (patch)
tree7c026bc04c1d512bfad6f2643f7e4184394d2a19
parent84a5d827f3f32684cffafe59d4694c1deeed2456 (diff)
Add TUWF::Validate::Interop::elm_decoder()
-rw-r--r--lib/TUWF/Validate/Interop.pm52
1 files changed, 52 insertions, 0 deletions
diff --git a/lib/TUWF/Validate/Interop.pm b/lib/TUWF/Validate/Interop.pm
index 7da63b3..047bd71 100644
--- a/lib/TUWF/Validate/Interop.pm
+++ b/lib/TUWF/Validate/Interop.pm
@@ -220,4 +220,56 @@ sub elm_encoder {
croak "Unknown type '$o->{type}' or missing option";
}
+
+# Elm JSON decoder for values of elm_type()
+# options: elm_type() options + json_decode var_prefix
+sub elm_decoder {
+ my($o, %opt) = @_;
+ $opt{json_decode} //= '';
+ $opt{var_prefix} //= 'd';
+
+ return sprintf '(%snullable %s)',
+ $opt{json_decode}, $opt{values} || $o->elm_decoder(%opt, required => 1)
+ if !$o->{required} && !defined $o->{default} && !$opt{required};
+
+ delete $opt{required};
+ return "$opt{json_decode}string" if $o->{type} eq 'scalar';
+ return "$opt{json_decode}bool" if $o->{type} eq 'bool';
+ return "$opt{json_decode}float" if $o->{type} eq 'num';
+ return "$opt{json_decode}int" if $o->{type} eq 'int';
+ return $opt{any} if $o->{type} eq 'any' && $opt{any};
+ return "$opt{json_decode}value" if $o->{type} eq 'any';
+ return sprintf '(%slist %s)', $opt{json_decode}, $opt{values} || $o->{values}->elm_decoder(%opt)
+ if $o->{type} eq 'array' && ($opt{values} || $o->{values});
+
+ if($o->{type} eq 'hash' && ($o->{keys} || $opt{keys})) {
+ $opt{indent} //= 2;
+ $opt{level} //= 1;
+ my $len = 0;
+ $len = length $_ > $len ? length $_ : $len for keys %{$o->{keys}};
+
+ my $num = keys %{$o->{keys}};
+ my $varnum = 1;
+ croak 'Unable to decode maps with more than 8 members' if $num > 8;
+
+ my(@fnarg, @assign, @fetch);
+ for (sort keys %{$o->{keys}}) {
+ my $var = $opt{var_prefix}.($varnum++);
+ push @fnarg, $var;
+ push @assign, "$_ = $var";
+ push @fetch, sprintf '(%sfield "%s"%s %s)', $opt{json_decode}, $_,
+ ' 'x($len-(length $_)),
+ $opt{keys}{$_} || $o->{keys}{$_}->elm_decoder(%opt, var_prefix => $var, level => $opt{level}+1);
+ }
+ my $r = sprintf "(%smap%d\n(\\%s -> { %s })\n%s)",
+ $opt{json_decode}, $num, join(' ', @fnarg), join(', ', @assign), join("\n", @fetch);
+
+ $r =~ s/\n/$opt{indent} ? "\n" . (' 'x($opt{indent}*$opt{level})) : ''/eg;
+ return $r;
+ }
+
+ croak "Unknown type '$o->{type}' or missing option";
+}
+
+
1;