summaryrefslogtreecommitdiff
path: root/lib/VNWeb/Elm.pm
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2019-09-25 18:37:29 +0200
committerYorhel <git@yorhel.nl>2019-09-25 18:49:19 +0200
commitd735e66d7d9b2d8c9a965ec96753864ff8c306c2 (patch)
treece0214b9e3cc819252b9192e7518f7768e568c77 /lib/VNWeb/Elm.pm
parentc7642c03d99ed0255614a43fb82e55a1dde66753 (diff)
v2rw: Add Elm & db_edit framework + Convert doc page editing
Most of this is copied from v3. I did improve on a few aspects: - db_edit() and db_entry() use VNDB::Schema rather than dynamically querying the DB. This has the minor advantage of a faster startup. - The Elm code generator now writes to multiple files, this avoids the namespace pollution seen in v3's Lib.Gen and makes the dependency graph a bit more lean (i.e. faster incremental builds). - The Elm code generator doesn't update the timestamp of files that haven't been modified. This also speeds up incremental builds, the elm compiler can now skip rebuilding unmodified files. - The Elm API response generator code now uses plain functions rather than code references and all possible responses are now defined in Elm.pm. Turns out most API responses were used from more than a single place, so it makes sense to have them centrally defined. The doc page preview function is also much nicer; I'd like to apply this to all BBCode textareas as well. (Elm.pm itself is ugly as hell though. And we will prolly need some HTML form generation functions in Elm to make that part less verbose)
Diffstat (limited to 'lib/VNWeb/Elm.pm')
-rw-r--r--lib/VNWeb/Elm.pm236
1 files changed, 236 insertions, 0 deletions
diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm
new file mode 100644
index 00000000..ea181e3c
--- /dev/null
+++ b/lib/VNWeb/Elm.pm
@@ -0,0 +1,236 @@
+# This module is responsible for generating elm/Gen/*.
+#
+# It exports an `elm_form` function to generate type definitions, a JSON
+# encoder and HTML5 validation attributes to simplify and synchronize forms.
+#
+# It also exports an `elm_Response` function for each possible API response
+# (see %apis below).
+
+package VNWeb::Elm;
+
+use strict;
+use warnings;
+use TUWF;
+use Exporter 'import';
+use List::Util 'max';
+use VNDB::Config;
+use VNDB::Types;
+use VNWeb::Auth;
+
+our @EXPORT = qw/
+ elm_form
+/;
+
+
+# API response types and arguments. To generate an API response from Perl, call
+# elm_ResponseName(@args), e.g.:
+#
+# elm_Changed $id, $revision;
+#
+# These API responses are available in Elm in the `Gen.Api.Response` union type.
+my %apis = (
+ Unauth => [], # Not authorized
+ Unchanged => [], # No changes
+ Changed => [ { id => 1 }, { uint => 1 } ], # [ id, chrev]; DB entry has been successfully changed
+ Success => [],
+ CSRF => [], # Invalid CSRF token
+ Invalid => [], # POST data did not validate the schema
+ Content => [{}], # Rendered HTML content (for markdown/bbcode APIs)
+);
+
+
+# Generate the elm_Response() functions
+for my $name (keys %apis) {
+ no strict 'refs';
+ $apis{$name} = [ map tuwf->compile($_), $apis{$name}->@* ];
+ *{'elm_'.$name} = sub {
+ my @args = map {
+ $apis{$name}[$_]->validate($_[$_])->data if tuwf->debug;
+ $apis{$name}[$_]->analyze->coerce_for_json($_[$_], unknown => 'reject')
+ } 0..$#{$apis{$name}};
+ tuwf->resJSON({$name, \@args})
+ };
+ push @EXPORT, 'elm_'.$name;
+}
+
+
+
+
+# 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; }
+
+# Generate a variable definition: name, type, value
+sub def($$$) { sprintf "\n%s : %s\n%1\$s = %s\n", @_; }
+
+
+# Generate an Elm type definition corresponding to a TUWF::Validate schema
+sub def_type {
+ my($name, $obj) = @_;
+ my $data = '';
+ my @keys = $obj->{keys} ? grep $obj->{keys}{$_}{keys}||($obj->{keys}{$_}{values}&&$obj->{keys}{$_}{values}{keys}), sort keys $obj->{keys}->%* : ();
+
+ $data .= 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 }
+ );
+ $data
+}
+
+
+# Generate HTML5 validation attribute lists corresponding to a TUWF::Validate schema
+# TODO: Deduplicate some regexes (weburl, email)
+# TODO: Throw these inside a struct for better namespacing?
+sub def_validation {
+ my($name, $obj) = @_;
+ $obj = $obj->{values} if $obj->{values};
+ my $data = '';
+
+ $data .= def_validation($name . to_camel($_), $obj->{keys}{$_}) for $obj->{keys} ? sort keys $obj->{keys}->%* : ();
+
+ my %v = $obj->html5_validation();
+ $data .= def $name, 'List (Html.Attribute msg)', '[ '.join(', ',
+ $v{required} ? 'A.required True' : (),
+ $v{minlength} ? "A.minlength $v{minlength}" : (),
+ $v{maxlength} ? "A.maxlength $v{maxlength}" : (),
+ $v{min} ? "A.min $v{min}" : (),
+ $v{max} ? "A.max $v{max}" : (),
+ $v{pattern} ? 'A.pattern '.string($v{pattern}) : ()
+ ).']' if !$obj->{keys};
+ $data;
+}
+
+
+# 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.');
+}
+
+
+
+
+sub write_module {
+ my($module, $contents) = @_;
+ my $fn = sprintf '%s/elm/Gen/%s.elm', config->{root}, $module;
+
+ # The imports aren't necessary in all the files, but might as well add them.
+ $contents = <<~"EOF";
+ -- This file is automatically generated from lib/VNWeb/Elm.pm.
+ -- Do not edit, your changes will be lost.
+ module Gen.$module exposing (..)
+ import Http
+ import Html
+ import Html.Attributes as A
+ import Json.Encode as JE
+ import Json.Decode as JD
+ $contents
+ EOF
+
+ # Don't write anything if the file hasn't changed.
+ my $oldcontents = do {
+ local $/=undef; my $F;
+ open($F, '<:utf8', $fn) ? <$F> : '';
+ };
+ return if $oldcontents eq $contents;
+
+ open my $F, '>:utf8', $fn or die "$fn: $!";
+ print $F $contents;
+}
+
+
+
+
+
+# Create type definitions and a JSON encoder for a typical form.
+# Usage:
+#
+# elm_form 'FormName', $TO_ELM_SCHEMA, $TO_SERVER_SCHEMA;
+#
+# That will create a Gen.FormName module with the following definitions:
+#
+# type alias Recv = { .. }
+# type alias Send = { .. }
+# encode : Send -> JE.Value
+# valFieldName : List Html.Attribute
+#
+sub elm_form {
+ return if !tuwf->{elmgen};
+ my($name, $out, $in) = @_;
+
+ my $data = '';
+ $data .= def_type Recv => $out->analyze;
+ $data .= def_type Send => $in->analyze;
+ $data .= encoder encode => 'Send', $in->analyze;
+ $data .= def_validation val => $in->analyze;
+
+ write_module $name, $data;
+}
+
+
+
+# Generate the Gen.Api module with the Response type and decoder.
+sub write_api {
+
+ # 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 $data = '';
+ 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}) {
+ $data .= def_type $tname, $arg;
+ $def .= " $tname";
+ } elsif($arg->{values} && $arg->{values}{keys}) {
+ $data .= def_type $tname, $arg->{values};
+ $def .= " (List $tname)";
+ } else {
+ $def .= ' '.$arg->elm_type();
+ }
+ }
+ push @union, $def;
+ push @decode, $dec;
+ }
+ $data .= sprintf "\ntype Response\n = HTTPError Http.Error\n | %s\n", join "\n | ", @union;
+ $data .= sprintf "\ndecode : JD.Decoder Response\ndecode = JD.oneOf\n [ %s\n ]", join "\n , ", @decode;
+
+ write_module Api => $data;
+};
+
+
+sub write_types {
+ my $data = '';
+
+ $data .= def urlStatic => String => string config->{url_static};
+
+ write_module Types => $data;
+}
+
+
+if(tuwf->{elmgen}) {
+ mkdir config->{root}.'/elm/Gen';
+ write_api;
+ write_types;
+ open my $F, '>', config->{root}.'/elm/Gen/.generated';
+ print $F scalar gmtime;
+}
+
+
+1;