1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
# This module is responsible for generating elm3/Lib/Gen.elm. Variables and
# type definitions can be added from any Perl module by calling def(),
# elm_form() and elm_api() at file load time.
package VN3::ElmGen;
use strict;
use warnings;
use TUWF;
use Exporter 'import';
use List::Util 'max';
use VN3::Auth;
use VN3::Types;
use VNDB::Types;
our @EXPORT = qw/
elm_form elm_api
$elm_Unauth $elm_Unchanged $elm_Changed $elm_Success $elm_CSRF
/;
my $data = <<_;
-- This file is automatically generated from lib/VN3/ElmGen.pm
-- DO NOT EDIT!
module Lib.Gen exposing (..)
import Http
import Json.Encode as JE
import Json.Decode as JD
type alias Medium =
{ qty : Bool
, single : String
, plural : String
}
_
# Formatting functions
sub indent($) { $_[0] =~ s/\n/\n /gr }
sub list { indent "\n[ ".join("\n, ", @_)."\n]" }
sub string($) { '"'.($_[0] =~ s/([\\"])/\\$1/gr).'"' }
sub tuple { '('.join(', ', @_).')' }
sub bool($) { $_[0] ? 'True' : 'False' }
sub to_camel { (ucfirst $_[0]) =~ s/_([a-z])/'_'.uc $1/egr; }
# Output a variable definition: name, type, value
sub def($$$) { $data .= sprintf "\n%s : %s\n%1\$s = %s\n", @_; }
# Define an Elm type corresponding to a TUWF::Validate schema
sub def_type {
my($name, $obj) = @_;
my @keys = $obj->{keys} ? grep $obj->{keys}{$_}{keys}||($obj->{keys}{$_}{values}&&$obj->{keys}{$_}{values}{keys}), sort keys %{$obj->{keys}} : ();
def_type($name . to_camel($_), $obj->{keys}{$_}{values} || $obj->{keys}{$_}) for @keys;
$data .= sprintf "\ntype alias %s = %s\n\n", $name, $obj->elm_type(
keys => +{ map +($_, ($obj->{keys}{$_}{values} ? 'List ' : '') . $name . to_camel($_)), @keys }
);
}
# Define an Elm JSON encoder taking a corresponding def_type() as input
sub encoder {
my($name, $type, $obj) = @_;
def $name, "$type -> JE.Value", $obj->elm_encoder(json_encode => 'JE.');
}
# Create type definitions and a JSON encoder for a typical form.
# Usage:
#
# elm_form 'FormName', $TO_ELM_SCHEMA, $TO_SERVER_SCHEMA;
#
# That will define:
#
# type alias FormName = { .. }
# type alias FormNameSend = { .. }
# formnameSendEncode : FormNameSend -> JE.Value
#
sub elm_form {
my($name, $out, $in) = @_;
def_type $name, $out->analyze;
def_type $name.'Send', $in->analyze;
encoder lc($name).'SendEncode', $name.'Send', $in->analyze;
}
my %apis;
# Define an API response. This will be added to the 'Lib.Api.Response' union type.
# Usage:
#
# # At file scope:
# my $json_generator = elm_api_response UnionName => $SCHEMA1, $SCHEMA2, ..;
#
# # Later, to actually generate a JSON response:
# $json_generator->($data1, $data2, ..);
#
# Limitation: There may be only a single $SCHEMA with an embedded {type => 'hash'}.
sub elm_api {
my($name, @schema) = @_;
@schema = map tuwf->compile($_), @schema;
$apis{$name} = \@schema;
sub {
# TODO: Validate $data? Easier to catch bugs that way
tuwf->resJSON({$name, @schema ? [map $schema[$_]->analyze->coerce_for_json($_[$_], unknown => 'reject'), 0..$#schema] : 1})
}
}
# Common API responses.
our $elm_Unauth = elm_api 'Unauth';
our $elm_Unchanged = elm_api 'Unchanged';
our $elm_Changed = elm_api 'Changed', { id => 1 }, { uint => 1 };
our $elm_Success = elm_api 'Success';
our $elm_CSRF = elm_api 'CSRF';
sub print {
# Generate the ApiResponse type and decoder.
#
# Extract all { type => 'hash' } schemas and give them their own
# definition, so that it's easy to refer to those records in other places
# of the Elm code, similar to def_type().
my(@union, @decode);
my $len = max map length, keys %apis;
for (sort keys %apis) {
my($name, $schema) = ($_, $apis{$_});
my $def = $name;
my $dec = sprintf 'JD.field "%s"%s <| %s', $name,
' 'x($len-(length $name)),
@$schema == 0 ? "JD.succeed $name" :
@$schema == 1 ? "JD.map $name" : sprintf 'JD.map%d %s', scalar @$schema, $name;
my $tname = "Api$name";
for my $argn (0..$#$schema) {
my $arg = $schema->[$argn]->analyze();
my $jd = $arg->elm_decoder(json_decode => 'JD.', level => 3);
$dec .= " (JD.index $argn $jd)";
if($arg->{keys}) {
def_type $tname, $arg;
$def .= " $tname";
#$dec .= $jd;
} elsif($arg->{values} && $arg->{values}{keys}) {
def_type $tname, $arg->{values};
$def .= " (List $tname)";
#$dec .= "(JD.list $jd)";
} else {
$def .= ' '.$arg->elm_type();
#$dec .= $jd;
}
#$dec .= ')';
}
push @union, $def;
push @decode, $dec;
}
$data .= sprintf "\ntype ApiResponse\n = HTTPError Http.Error\n | %s\n", join "\n | ", @union;
$data .= sprintf "\ndecodeApiResponse : JD.Decoder ApiResponse\ndecodeApiResponse = JD.oneOf\n [ %s\n ]", join "\n , ", @decode;
print $data;
};
my $perms = VN3::Auth::listPerms();
def urlStatic => String => string tuwf->conf->{url_static};
def userPerms => 'List (Int, String)' => list map tuple($perms->{$_}, string $_), sort keys %$perms;
def vnLengths => 'List (Int, String)' => list map tuple($_, string vn_length_display $_), 0..$#VN_LENGTHS;
def vnRelations => 'List (String, String)' => list map tuple(string $_, string vn_relation_display $_), vn_relations;
def producerRelations => 'List (String, String)' => list map tuple(string $_, string producer_relation_display $_), keys %PRODUCER_RELATIONS;
def creditType => 'List (String, String)' => list map tuple(string $_, string $CREDIT_TYPE{$_}), keys %CREDIT_TYPE;
def languages => 'List (String, String)' => list map tuple(string $_, string $LANG{$_}), sort { $LANG{$a} cmp $LANG{$b} } keys %LANG;
def platforms => 'List (String, String)' => list map tuple(string $_, string $PLATFORMS{$_}), keys %PLATFORMS;
def releaseTypes => 'List String' => list map string($_), release_types;
def producerTypes => 'List (String, String)' => list map tuple(string $_, string $PRODUCER_TYPES{$_}), keys %PRODUCER_TYPES;
def minAges => 'List (Int, String)' => list map tuple($_, string minage_display_full $_), @MINAGE;
def resolutions => 'List (String, String)' => list map tuple(string $_, string resolution_display_full $_), keys %RESOLUTIONS;
def voiced => 'List String' => list map string($_), @VOICED;
def animated => 'List String' => list map string($_), @ANIMATED;
def genders => 'List (String, String)' => list map tuple(string $_, string gender_display $_), keys %GENDERS;
def bloodTypes => 'List (String, String)' => list map tuple(string $_, string blood_type_display $_), keys %BLOOD_TYPES;
def charRoles => 'List (String, String)' => list map tuple(string $_, string char_role_display $_), keys %CHAR_ROLES;
def vnlistStatus => 'List (Int, String)' => list map tuple($_, string $VNLIST_STATUS[$_]), 0..$#VNLIST_STATUS;
def emailPattern => String => string { tuwf->compile({ email => 1 })->analyze->html5_validation() }->{pattern};
def weburlPattern => String => string { tuwf->compile({ weburl => 1 })->analyze->html5_validation() }->{pattern};
def vnvotePattern => String => string { tuwf->compile({ vnvote => 1 })->analyze->html5_validation() }->{pattern};
def media => 'List (String, Medium)' =>
list map tuple(
string($_),
sprintf('{ qty = %s, single = %s, plural = %s }', bool($MEDIA{$_}{qty}), string($MEDIA{$_}{single}), string($MEDIA{$_}{plural}))
), keys %MEDIA;
1;
|
