summaryrefslogtreecommitdiff
path: root/lib/VNWeb/Elm.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/VNWeb/Elm.pm')
-rw-r--r--lib/VNWeb/Elm.pm196
1 files changed, 103 insertions, 93 deletions
diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm
index 13165959..ad4f80a3 100644
--- a/lib/VNWeb/Elm.pm
+++ b/lib/VNWeb/Elm.pm
@@ -1,4 +1,4 @@
-# This module is responsible for generating elm/Gen/*.
+# This module is responsible for generating elm/Gen/*;
#
# It exports an `elm_api` function to create an API endpoint, type definitions,
# a JSON encoder and HTML5 validation attributes to simplify and synchronize
@@ -18,6 +18,8 @@ use VNDB::Config;
use VNDB::Types;
use VNDB::Func 'fmtrating';
use VNDB::ExtLinks ();
+use VNDB::Skins;
+use VNWeb::Validation;
use VNWeb::Auth;
our @EXPORT = qw/
@@ -36,25 +38,19 @@ our %apis = (
Unchanged => [], # No changes
Success => [],
Redirect => [{}], # Redirect to the given URL
- CSRF => [], # Invalid CSRF token
Invalid => [], # POST data did not validate the schema
Editsum => [], # Invalid edit summary
Content => [{}], # Rendered HTML content (for markdown/bbcode APIs)
- BadLogin => [], # Invalid user or pass
- LoginThrottle => [], # Too many failed login attempts
- InsecurePass => [], # Password is in a dictionary or breach database
- BadEmail => [], # Unknown email address in password reset form
- Bot => [], # User didn't pass bot verification
- Taken => [], # Username already taken
- DoubleEmail => [], # Account with same email already exists
- DoubleIP => [], # Account with same IP already exists
- BadCurPass => [], # Current password is incorrect when changing password
- MailChange => [], # A confirmation mail has been sent to change a user's email address
ImgFormat => [], # Unrecognized image format
+ LabelId => [{uint => 1}], # Label created
+ DupNames => [ { aoh => { # Duplicate names/aliases (for tags & traits)
+ id => { vndbid => ['i','g'] },
+ name => {},
+ } } ],
Releases => [ { aoh => { # Response to 'Release'
- id => { id => 1 },
+ id => { vndbid => 'r' },
title => {},
- original => { required => 0, default => '' },
+ alttitle => { default => '' },
released => { uint => 1 },
rtype => {},
reso_x => { uint => 1 },
@@ -62,87 +58,130 @@ our %apis = (
lang => { type => 'array', values => {} },
platforms=> { type => 'array', values => {} },
} } ],
+ Resolutions => [ { aoh => { # Response to 'Resolutions'
+ resolution => {},
+ count => { uint => 1 },
+ } } ],
+ Engines => [ { aoh => { # Response to 'Engines'
+ engine => {},
+ count => { uint => 1 },
+ } } ],
+ DRM => [ { aoh => { # Response to 'DRM'
+ name => {},
+ count => { uint => 1 },
+ } } ],
BoardResult => [ { aoh => { # Response to 'Boards'
- btype => {},
- iid => { required => 0, default => 0, id => 1 },
- title => { required => 0 },
+ btype => { enum => \%BOARD_TYPE },
+ iid => { default => undef, vndbid => ['p','v','u'] },
+ title => { default => undef },
} } ],
TagResult => [ { aoh => { # Response to 'Tags'
- id => { id => 1 },
+ id => { vndbid => 'g' },
name => {},
searchable => { anybool => 1 },
applicable => { anybool => 1 },
- state => { int => 1 },
+ hidden => { anybool => 1 },
+ locked => { anybool => 1 },
} } ],
TraitResult => [ { aoh => { # Response to 'Traits'
- id => { id => 1 },
+ id => { vndbid => 'i' },
name => {},
searchable => { anybool => 1 },
applicable => { anybool => 1 },
- state => { int => 1 },
defaultspoil => { uint => 1 },
- group_id => { required => 0, uint => 1 },
- group_name => { required => 0 },
+ hidden => { anybool => 1 },
+ locked => { anybool => 1 },
+ group_id => { default => undef, vndbid => 'i' },
+ group_name => { default => undef },
} } ],
VNResult => [ { aoh => { # Response to 'VN'
- id => { id => 1 },
+ id => { vndbid => 'v' },
title => {},
- original => { required => 0, default => '' },
hidden => { anybool => 1 },
} } ],
ProducerResult => [ { aoh => { # Response to 'Producers'
- id => { id => 1 },
+ id => { vndbid => 'p' },
name => {},
- original => { required => 0, default => '' },
- hidden => { anybool => 1 },
+ altname => { default => undef },
} } ],
StaffResult => [ { aoh => { # Response to 'Staff'
- id => { id => 1 },
+ id => { vndbid => 's' },
+ lang => {},
aid => { id => 1 },
- name => {},
- original => { required => 0, default => '' },
+ title => {},
+ alttitle => {},
} } ],
CharResult => [ { aoh => { # Response to 'Chars'
- id => { id => 1 },
- name => {},
- original => { required => 0, default => '' },
- main => { required => 0, type => 'hash', keys => {
- id => { id => 1 },
- name => {},
- original => { required => 0, default => '' },
+ id => { vndbid => 'c' },
+ title => {},
+ alttitle => {},
+ main => { default => undef, type => 'hash', keys => {
+ id => { vndbid => 'c' },
+ title => {},
+ alttitle => {},
} }
} } ],
AnimeResult => [ { aoh => { # Response to 'Anime'
id => { id => 1 },
title => {},
- original => { required => 0, default => '' },
+ original => { default => '' },
} } ],
ImageResult => [ { aoh => { # Response to 'Images'
- id => { }, # image id...
- token => { required => 0 },
+ id => { vndbid => ['ch','cv','sf'] },
+ token => { default => undef },
width => { uint => 1 },
height => { uint => 1 },
votecount => { uint => 1 },
- sexual_avg => { num => 1, required => 0 },
- sexual_stddev => { num => 1, required => 0 },
- violence_avg => { num => 1, required => 0 },
- violence_stddev => { num => 1, required => 0 },
- my_sexual => { uint => 1, required => 0 },
- my_violence => { uint => 1, required => 0 },
+ sexual_avg => { num => 1, default => undef },
+ sexual_stddev => { num => 1, default => undef },
+ violence_avg => { num => 1, default => undef },
+ violence_stddev => { num => 1, default => undef },
+ my_sexual => { uint => 1, default => undef },
+ my_violence => { uint => 1, default => undef },
my_overrule => { anybool => 1 },
- entry => { required => 0, type => 'hash', keys => {
+ entry => { default => undef, type => 'hash', keys => {
id => {},
title => {},
} },
votes => { unique => 0, aoh => {
user => {},
- uid => { uint => 1, required => 0 },
+ uid => { vndbid => 'u', default => undef },
sexual => { uint => 1 },
violence => { uint => 1 },
ignore => { anybool => 1 },
} },
} } ],
);
+# (These references to other API results cause redundant Elm code - can be deduplicated)
+$apis{AdvSearchQuery} = [ { type => 'hash', keys => { # Response to 'AdvSearchLoad'
+ qtype => {},
+ query => { type => 'any' },
+ producers => $apis{ProducerResult}[0],
+ staff => $apis{StaffResult}[0],
+ tags => $apis{TagResult}[0],
+ traits => $apis{TraitResult}[0],
+ anime => $apis{AnimeResult}[0],
+} } ];
+$apis{UListWidget} = [ { type => 'hash', keys => { # Initialization for UList.Widget and response to UListWidget
+ uid => { vndbid => 'u' },
+ vid => { vndbid => 'v' },
+ # Only includes selected labels, null if the VN is not on the list at all.
+ labels => { default => undef, aoh => { id => { int => 1 }, label => {default => ''} } },
+ # Can be set to null to lazily load the extra data as needed
+ full => { default => undef, type => 'hash', keys => {
+ title => {},
+ labels => { aoh => { id => { int => 1 }, label => {}, private => { anybool => 1 } } },
+ canvote => { anybool => 1 },
+ canreview => { anybool => 1 },
+ vote => { vnvote => 1 },
+ review => { default => undef, vndbid => 'w' },
+ notes => { default => '' },
+ started => { default => '' },
+ finished => { default => '' },
+ releases => $apis{Releases}[0],
+ rlist => { aoh => { id => { vndbid => 'r' }, status => { uint => 1 } } },
+ } },
+} } ];
# Compile %apis into a %schema and generate the elm_Response() functions
@@ -184,6 +223,7 @@ sub def_type {
$data .= def_type($name . to_camel($_), $obj->{keys}{$_}{values} || bless { $obj->{keys}{$_}->%*, required => 1 }, ref $obj->{keys}{$_} ) for @keys;
$data .= sprintf "\ntype alias %s = %s\n\n", $name, $obj->elm_type(
+ any => 'JE.Value',
keys => +{ map {
my $t = $obj->{keys}{$_};
my $n = $name . to_camel($_);
@@ -223,7 +263,7 @@ sub def_validation {
# Generate 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.');
+ def $name, "$type -> JE.Value", $obj->elm_encoder(any => ' ', json_encode => 'JE.');
}
@@ -231,7 +271,7 @@ sub encoder {
sub write_module {
my($module, $contents) = @_;
- my $fn = sprintf '%s/elm/Gen/%s.elm', config->{root}, $module;
+ my $fn = sprintf '%s/elm/Gen/%s.elm', config->{gen_path}, $module;
# The imports aren't necessary in all the files, but might as well add them.
$contents = <<~"EOF";
@@ -293,11 +333,6 @@ sub elm_api {
$in = comp $in;
TUWF::post qr{/elm/\Q$name\E\.json} => sub {
- if(!tuwf->samesite && !auth->csrfcheck(tuwf->reqHeader('X-CSRF-Token')||'')) {
- warn "Invalid CSRF token in request\n";
- return elm_CSRF();
- }
-
my $data = tuwf->validate(json => $in);
# Handle failure of the 'editsum' validation as a special case and return elm_Editsum().
if(!$data && $data->err->{errors} && grep $_->{validation} eq 'editsum' || ($_->{validation} eq 'required' && $_->{key} eq 'editsum'), $data->err->{errors}->@*) {
@@ -344,7 +379,7 @@ sub elm_empty {
return [] if $schema->{type} eq 'array';
return '' if $schema->{type} eq 'bool' || $schema->{type} eq 'scalar';
return 0 if $schema->{type} eq 'num' || $schema->{type} eq 'int';
- return +{ map +($_, elm_empty($schema->{keys}{$_})), $schema->{keys} ? $schema->{keys}->%* : () } if $schema->{type} eq 'hash';
+ return +{ map +($_, elm_empty($schema->{keys}{$_})), $schema->{keys} ? keys $schema->{keys}->%* : () } if $schema->{type} eq 'hash';
die "Unable to initialize required value of type '$schema->{type}' without a default";
}
@@ -393,11 +428,7 @@ sub write_api {
sub write_types {
my $data = '';
- $data .= def adminEMail => String => string config->{admin_email};
- $data .= def skins => 'List (String, String)' =>
- list map tuple(string $_, string tuwf->{skins}{$_}[0]),
- sort { tuwf->{skins}{$a}[0] cmp tuwf->{skins}{$b}[0] } keys tuwf->{skins}->%*;
- $data .= def languages => 'List (String, String)' => list map tuple(string $_, string $LANGUAGE{$_}), sort { $LANGUAGE{$a} cmp $LANGUAGE{$b} } keys %LANGUAGE;
+ $data .= def languages => 'List (String, String)' => list map tuple(string $_, string $LANGUAGE{$_}{txt}), sort { $LANGUAGE{$a}{txt} cmp $LANGUAGE{$b}{txt} } keys %LANGUAGE;
$data .= def platforms => 'List (String, String)' => list map tuple(string $_, string $PLATFORM{$_}), keys %PLATFORM;
$data .= def releaseTypes => 'List (String, String)' => list map tuple(string $_, string $RELEASE_TYPE{$_}), keys %RELEASE_TYPE;
$data .= def media => 'List (String, String, Bool)' => list map tuple(string $_, string $MEDIUM{$_}{txt}, $MEDIUM{$_}{qty}?'True':'False'), keys %MEDIUM;
@@ -405,6 +436,7 @@ sub write_types {
$data .= def boardTypes => 'List (String, String)' => list map tuple(string $_, string $BOARD_TYPE{$_}{txt}), keys %BOARD_TYPE;
$data .= def ratings => 'List String' => list map string(fmtrating $_), 1..10;
$data .= def ageRatings => 'List (Int, String)' => list map tuple($_, string $AGE_RATING{$_}{txt}.($AGE_RATING{$_}{ex}?" ($AGE_RATING{$_}{ex})":'')), keys %AGE_RATING;
+ $data .= def devStatus => 'List (Int, String)' => list map tuple($_, string $DEVSTATUS{$_}), keys %DEVSTATUS;
$data .= def voiced => 'List (Int, String)' => list map tuple($_, string $VOICED{$_}{txt}), keys %VOICED;
$data .= def animated => 'List (Int, String)' => list map tuple($_, string $ANIMATED{$_}{txt}), keys %ANIMATED;
$data .= def genders => 'List (String, String)' => list map tuple(string $_, string $GENDER{$_}), keys %GENDER;
@@ -416,6 +448,7 @@ sub write_types {
$data .= def creditTypes=> 'List (String, String)' => list map tuple(string $_, string $CREDIT_TYPE{$_}), keys %CREDIT_TYPE;
$data .= def producerRelations=> 'List (String, String)' => list map tuple(string $_, string $PRODUCER_RELATION{$_}{txt}), keys %PRODUCER_RELATION;
$data .= def producerTypes=> 'List (String, String)' => list map tuple(string $_, string $PRODUCER_TYPE{$_}), keys %PRODUCER_TYPE;
+ $data .= def tagCategories=> 'List (String, String)' => list map tuple(string $_, string $TAG_CATEGORY{$_}), keys %TAG_CATEGORY;
$data .= def curYear => Int => (gmtime)[5]+1900;
write_module Types => $data;
@@ -425,59 +458,36 @@ sub write_types {
sub write_extlinks {
my $data =<<~'_';
import Regex
- import Gen.ReleaseEdit as GRE
- type alias Site a =
+ type alias Site =
{ name : String
- , fmt : String
- , regex : Regex.Regex
- , multi : Bool
- , links : a -> List String
- , del : Int -> a -> a
- , add : String -> a -> a
- , patt : List String
+ , advid : String
}
-
- reg r = Maybe.withDefault Regex.never (Regex.fromStringWith {caseInsensitive=True, multiline=False} r)
- delidx n l = List.take n l ++ List.drop (n+1) l
- toint v = Maybe.withDefault 0 (String.toInt v)
-
- -- Link extraction functions for `Site.links`, i=integer, s=string, m=multi
- li v = if v == 0 then [] else [String.fromInt v]
- lim = List.map String.fromInt
- ls v = if v == "" then [] else [v]
- lsm v = v
_
my sub links {
- my($name, $type, @links) = @_;
- $data .= def $name.'Sites' => "List (Site $type)" => list map {
+ my($name, @links) = @_;
+ $data .= def $name.'Sites' => "List (Site)" => list map {
my $l = $_;
my $addval = $l->{int} ? 'toint v' : 'v';
'{ '.join("\n , ",
'name = '.string($l->{name}),
- 'fmt = '.string($l->{fmt}),
- 'regex = reg '.string(TUWF::Validate::Interop::_re_compat($l->{regex})),
- 'multi = '.($l->{multi}?'True':'False'),
- 'links = '.sprintf('(\m -> l%s%s m.%s)', $l->{int}?'i':'s', $l->{multi}?'m':'', $l->{id}),
- 'del = (\i m -> { m | '.$l->{id}.' = '.($l->{multi} ? "delidx i m.$l->{id}" : $l->{default}).' })',
- 'add = (\v m -> { m | '.$l->{id}.' = '.($l->{multi} ? "m.$l->{id} ++ [$addval]" : $addval).' })',
- 'patt = ['.join(', ', map string($_), $l->{pattern}->@*).']'
+ 'advid = '.string($l->{id} =~ s/^l_//r),
)."\n }";
} @links;
}
- links release => 'GRE.RecvExtlinks' => VNDB::ExtLinks::extlinks_sites('r');
+ links release => VNDB::ExtLinks::extlinks_sites('r');
+ links staff => VNDB::ExtLinks::extlinks_sites('s');
write_module ExtLinks => $data;
}
if(tuwf->{elmgen}) {
- mkdir config->{root}.'/elm/Gen';
write_api;
write_types;
write_extlinks;
- open my $F, '>', config->{root}.'/elm/Gen/.generated';
+ open my $F, '>', config->{gen_path}.'/elm/Gen/.generated';
print $F scalar gmtime;
}