diff options
Diffstat (limited to 'lib/VN3/ElmGen.pm')
| -rw-r--r-- | lib/VN3/ElmGen.pm | 197 |
1 files changed, 0 insertions, 197 deletions
diff --git a/lib/VN3/ElmGen.pm b/lib/VN3/ElmGen.pm deleted file mode 100644 index fefc154e..00000000 --- a/lib/VN3/ElmGen.pm +++ /dev/null @@ -1,197 +0,0 @@ -# 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 VNWeb::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 = VNWeb::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 $_), keys %VN_LENGTH; -def vnRelations => 'List (String, String)' => list map tuple(string $_, string vn_relation_display $_), keys %VN_RELATION; -def producerRelations => 'List (String, String)' => list map tuple(string $_, string producer_relation_display $_), keys %PRODUCER_RELATION; -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 $LANGUAGE{$_}), sort { $LANGUAGE{$a} cmp $LANGUAGE{$b} } keys %LANGUAGE; -def platforms => 'List (String, String)' => list map tuple(string $_, string $PLATFORM{$_}), keys %PLATFORM; -def releaseTypes => 'List String' => list map string($_), release_types; -def producerTypes => 'List (String, String)' => list map tuple(string $_, string $PRODUCER_TYPE{$_}), keys %PRODUCER_TYPE; -def minAges => 'List (Int, String)' => list map tuple($_, string minage_display_full $_), keys %AGE_RATING; -def resolutions => 'List (String, String)' => list map tuple(string $_, string resolution_display_full $_), keys %RESOLUTION; -def voiced => 'List (Int, String)' => list map tuple($_, string($VOICED{$_})), keys %VOICED; -def animated => 'List (Int, String)' => list map tuple($_, string($ANIMATED{$_})), keys %ANIMATED; -def genders => 'List (String, String)' => list map tuple(string $_, string gender_display $_), keys %GENDER; -def bloodTypes => 'List (String, String)' => list map tuple(string $_, string blood_type_display $_), keys %BLOOD_TYPE; -def charRoles => 'List (String, String)' => list map tuple(string $_, string char_role_display $_), keys %CHAR_ROLE; -def vnlistStatus => 'List (Int, String)' => list map tuple($_, string $VNLIST_STATUS{$_}), keys %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($MEDIUM{$_}{qty}), string($MEDIUM{$_}{txt}), string($MEDIUM{$_}{plural})) - ), keys %MEDIUM; - - -1; |